求输入TT,图纸上有这中文字 比如TL-3~8点击这个文字，在边上生成TL-3 TL-4

664571221

求输入TT,图纸上有这中文字 比如TL-3~8点击这个文字，在边上生成TL-3 TL-4  TL-5 TL-6 TL-7 TL-8

弥勒

• ;20240910
• (defun c:zz(/ mystr mystrfg mysort Nstart i Nend pt mystrstrcat)
•   (setvar "cmdecho" 0)
•   (setq mystr   (car (Extract_DXF_Values (car (entsel "\n选字:")) 1)))
•   (setq mystrfg (car(strsplit mystr '("~" "-" "*" "," ";" " " "=" "分隔")) ))
•   (setq mysort  (car mystrfg))
•   (setq Nstart  (cadr mystrfg))
•   (setq i (atoi Nstart) )
•   (setq Nend   (caddr mystrfg))
•   (setq pt  (getpoint "选取点位置："))
•   (repeat (+ (-(atoi Nend) (atoi Nstart ) ) 1)  
•           (setq mystrstrcat (strcat mysort "-" (rtos i 2 0) ))
•           (setq i ( + i 1))
•           (setq pt (polar pt (* pi 1.5)  2))
•           (entmake (list '(0 . "TEXT") (cons 1 mystrstrcat) (cons 7 "宋体")(cons 10 pt) (cons 40 1)))
•   )
•   (setvar "cmdecho" 1)
• )
• (defun strsplit(str splits / i a b)
•   (while(<""str)
•     (if(vl-remove'nil(mapcar'(lambda(x)(vl-string-search x str))splits))
•       (setq i(car(vl-sort(vl-remove'nil(mapcar'(lambda(x)(if(setq l(vl-string-search x str))(cons l x)))splits))
•        '(lambda(s1 s2)(<(car s1)(car s2)))))
•       a(cons(substr str 1(car i))a)b(cons(cdr i)b)
•       str(substr str(+(car i)(strlen(cdr i))1)))
•       (setq a(cons str a)b(cons "" b)str"")))
•      (list(reverse a)(reverse b))
• )
• (defun Extract_DXF_Values(Ent Code)
•        (mapcar 'cdr (vl-remove-if-not'(lambda(a)(=(car a)Code))(entget Ent)))
• )
  

夏生生

未测试，仅考虑左对齐text图元

1. (defun c:tt  (/ a b c en ent h m n pt str)
   
2. (while        (setq en (car (entsel "\n拾取文字:")))
   
3.   (setq str (cdr (assoc 1 (setq ent (entget en)))))
   
4.   (if (wcmatch str "*`-*`~*")
   
5.    (progn (setq        m (vl-string-search "-" str)
   
6.                 n (vl-string-search "~" str)
   
7.                 a (substr str 1 m)
   
8.                 b (substr str (+ 2 m) (- n m 1))
   
9.                 c (substr str (+ 2 n))
   
10.                 b (atoi b)
    
11.                 c (atoi c)
    
12.                 h (cdr (assoc 40 ent)))
    
13.           (setq pt (getpoint "\n拾取点:"))
    
14.           (repeat (- c b -1)
    
15.            (setq ent (subst (cons 10 pt) (assoc 10 ent) ent)
    
16.                  ent (subst (cons 1 (strcat a "-" (itoa b))) (assoc 1 ent) ent)
    
17.                  pt  (polar pt (* -0.5 pi) h)
    
18.                  b   (1+ b))
    
19.            (entmake ent)))))
    
20. (princ))

(defun c:tt  (/ a b c en ent h m n pt str)<br /> (while        (setq en (car (entsel "\n拾取文字:")))<br />   (setq str (cdr (assoc 1 (setq ent (entget en)))))<br />   (if (wcmatch str "*`-*`~*")<br />    (progn (setq        m (vl-string-search "-" str)<br />                 n (vl-string-search "~" str)<br />                 a (substr str 1 m)<br />                 b (substr str (+ 2 m) (- n m 1))<br />                 c (substr str (+ 2 n))<br />                 b (atoi b)<br />                 c (atoi c)<br />                 h (cdr (assoc 40 ent)))<br />           (setq pt (getpoint "\n拾取点:"))<br />           (repeat (- c b -1)<br />            (setq ent (subst (cons 10 pt) (assoc 10 ent) ent)<br />                  ent (subst (cons 1 (strcat a "-" (itoa b))) (assoc 1 ent) ent)<br />                  pt  (polar pt (* -0.5 pi) h)<br />                  b   (1+ b))<br />            (entmake ent)))))<br /> (princ))

夏生生

经测试，改了下，可针对任意对齐方式text图元
留上贴，以对比

1. (defun c:tt  (/ a b c en ent h m n pt str)
   
2. (while        (setq en (car (entsel "\n拾取文字:")))
   
3.   (setq str (cdr (assoc 1 (setq ent (entget en)))))
   
4.   (if (wcmatch str "*`-*`~*")
   
5.    (progn (setq        m   (vl-string-search "-" str)
   
6.                 n   (vl-string-search "~" str)
   
7.                 a   (substr str 1 m)
   
8.                 b   (substr str (+ 2 m) (- n m 1))
   
9.                 c   (substr str (+ 2 n))
   
10.                 b   (atoi b)
    
11.                 c   (atoi c)
    
12.                 h   (cdr (assoc 40 ent))
    
13.                 pt  (getpoint "\n拾取点:")
    
14.                 ent (subst (cons 72 0) (assoc 72 ent) ent)
    
15.                 ent (subst (cons 73 0) (assoc 73 ent) ent))
    
16.           (repeat (- c b -1)
    
17.            (setq ent (subst (cons 10 pt) (assoc 10 ent) ent)
    
18.                  ent (subst (cons 1 (strcat a "-" (itoa b))) (assoc 1 ent) ent)
    
19.                  pt  (polar pt (* -0.5 pi) h)
    
20.                  b   (1+ b))
    
21.            (entmake ent)))))
    
22. (princ))

(defun c:tt  (/ a b c en ent h m n pt str)<br /> (while        (setq en (car (entsel "\n拾取文字:")))<br />   (setq str (cdr (assoc 1 (setq ent (entget en)))))<br />   (if (wcmatch str "*`-*`~*")<br />    (progn (setq        m   (vl-string-search "-" str)<br />                 n   (vl-string-search "~" str)<br />                 a   (substr str 1 m)<br />                 b   (substr str (+ 2 m) (- n m 1))<br />                 c   (substr str (+ 2 n))<br />                 b   (atoi b)<br />                 c   (atoi c)<br />                 h   (cdr (assoc 40 ent))<br />                 pt  (getpoint "\n拾取点:")<br />                 ent (subst (cons 72 0) (assoc 72 ent) ent)<br />                 ent (subst (cons 73 0) (assoc 73 ent) ent))<br />           (repeat (- c b -1)<br />            (setq ent (subst (cons 10 pt) (assoc 10 ent) ent)<br />                  ent (subst (cons 1 (strcat a "-" (itoa b))) (assoc 1 ent) ent)<br />                  pt  (polar pt (* -0.5 pi) h)<br />                  b   (1+ b))<br />            (entmake ent)))))<br /> (princ))

xyp1964

1. (defun c:tt () ;"编号分解写字"
   
2.   (setq j -1)
   
3.   (if (setq ss (ssget '((0 . "text") (1 . "*-*~*"))))
   
4.     (while (setq s1 (ssname ss (setq j (1+ j))))
   
5.       (setq tx (xyp-DXF 1 s1))
   
6.       (setq lst (xyp-StrSprMult tx '("-" "~")))
   
7.       (setq i (atoi (cadr lst)))
   
8.       (setq th (xyp-DXF 40 s1))
   
9.       (xyp-Ctbl (/ th 3.))
   
10.       (setq qz  (car lst)
    
11.             nn  (1+ (- (atoi (caddr lst)) i))
    
12.             pt  (xyp-Pt2X (xyp-9pt s1 6) th)
    
13.             lst '()
    
14.       )
    
15.       (repeat nn
    
16.         (setq lst (cons (strcat qz "-" (itoa i)) lst)
    
17.               i   (1+ i)
    
18.         )
    
19.       )
    
20.       (xyp-List2Text (reverse lst) 4 pt (* th 1.5))
    
21.     )
    
22.   )
    
23.   (princ)
    
24. )

(defun c:tt () ;"编号分解写字"<br />   (setq j -1)<br />   (if (setq ss (ssget '((0 . "text") (1 . "*-*~*"))))<br />     (while (setq s1 (ssname ss (setq j (1+ j))))<br />       (setq tx (xyp-DXF 1 s1))<br />       (setq lst (xyp-StrSprMult tx '("-" "~")))<br />       (setq i (atoi (cadr lst)))<br />       (setq th (xyp-DXF 40 s1))<br />       (xyp-Ctbl (/ th 3.))<br />       (setq qz  (car lst)<br />             nn  (1+ (- (atoi (caddr lst)) i))<br />             pt  (xyp-Pt2X (xyp-9pt s1 6) th)<br />             lst '()<br />       )<br />       (repeat nn<br />         (setq lst (cons (strcat qz "-" (itoa i)) lst)<br />               i   (1+ i)<br />         )<br />       )<br />       (xyp-List2Text (reverse lst) 4 pt (* th 1.5))<br />     )<br />   )<br />   (princ)<br /> )

统一网名

• (defun c:tt (/ a b c d i l p0 pt sd-dxf wznr zf zt ztgd ztys)
•   (setq sd-dxf (entget (car (entsel "\n选择对象:"))));获取对象数据
•   (setq zf (cdr(assoc 1 sd-dxf)))
•   (setq ztgd (cdr(assoc 40 sd-dxf)))
•   (setq L (* ztgd 5))
•   (setq zt (cdr(assoc 7 sd-dxf)))
•   (setq p0 (cdr(assoc 10 sd-dxf)))
•   (setq pt (list(+(car p0)L)(cadr p0)))
•   (setq a (car(sparser zf "-")))
•   (setq b(sparser (cadr (sparser zf "-")) "~"))
•   (setq c (fix(atof(nth 0 b))) d (fix(atof(nth 1 b))))
•   (setq i c ztys 1)
•   (repeat (+(- d c)1)
•     (setq wznr(strcat a "-" (itoa i)))
•     (entmake(list '(0 . "TEXT")(cons 1 wznr)(cons 10 pt)(cons 7 zt)(cons 40 ztgd)(cons 62 ztys)))
•     (setq i (+ i 1))
•     (setq pt (list (car pt)(-(cadr pt)(+ ztgd 100))))
•   )
•   (princ)
• )
• ;删除字符串中的字符
• (defun sparser (str delim / ptr lst)
•   (vl-load-com)
•   (while (setq ptr (vl-string-search delim str))
•     (setq lst (cons (substr str 1 ptr) lst))
•     (setq str (substr str (+ ptr 2)))
•   )
•   (reverse (cons str lst))
• )
  

664571221

弥勒 发表于 2024-9-10 11:01

;20240910

(defun c:zz(/ mystr mystrfg mysort Nstart i Nend pt mystrstrcat)

  (setvar "c ...

谢谢兄弟........

664571221

夏生生 发表于 2024-9-10 11:02
未测试，仅考虑左对齐text图元

谢谢大哥................

664571221

xyp1964 发表于 2024-9-10 13:00

谢谢派大...

664571221

统一网名 发表于 2024-9-10 14:19

(defun c:tt (/ a b c d i l p0 pt sd-dxf wznr zf zt ztgd ztys)

  (setq sd-dxf (entget (car ( ...

谢谢大哥.....