求输入TT,图纸上有这中文字 比如TL-3~8点击这个文字，在边上生成TL-3 TL-4
本帖最后由 664571221 于 2024-9-10 09:14 编辑求输入TT,图纸上有这中文字 比如TL-3~8点击这个文字，在边上生成TL-3 TL-4TL-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图元
(defun c:tt(/ a b c en ent h m n pt str)
(while (setq en (car (entsel "\n拾取文字:")))
(setq str (cdr (assoc 1 (setq ent (entget en)))))
(if (wcmatch str "*`-*`~*")
(progn (setq m (vl-string-search "-" str)
n (vl-string-search "~" str)
a (substr str 1 m)
b (substr str (+ 2 m) (- n m 1))
c (substr str (+ 2 n))
b (atoi b)
c (atoi c)
h (cdr (assoc 40 ent)))
(setq pt (getpoint "\n拾取点:"))
(repeat (- c b -1)
(setq ent (subst (cons 10 pt) (assoc 10 ent) ent)
ent (subst (cons 1 (strcat a "-" (itoa b))) (assoc 1 ent) ent)
pt(polar pt (* -0.5 pi) h)
b (1+ b))
(entmake ent)))))
(princ)) 经测试，改了下，可针对任意对齐方式text图元
留上贴，以对比
(defun c:tt(/ a b c en ent h m n pt str)
(while (setq en (car (entsel "\n拾取文字:")))
(setq str (cdr (assoc 1 (setq ent (entget en)))))
(if (wcmatch str "*`-*`~*")
(progn (setq m (vl-string-search "-" str)
n (vl-string-search "~" str)
a (substr str 1 m)
b (substr str (+ 2 m) (- n m 1))
c (substr str (+ 2 n))
b (atoi b)
c (atoi c)
h (cdr (assoc 40 ent))
pt(getpoint "\n拾取点:")
ent (subst (cons 72 0) (assoc 72 ent) ent)
ent (subst (cons 73 0) (assoc 73 ent) ent))
(repeat (- c b -1)
(setq ent (subst (cons 10 pt) (assoc 10 ent) ent)
ent (subst (cons 1 (strcat a "-" (itoa b))) (assoc 1 ent) ent)
pt(polar pt (* -0.5 pi) h)
b (1+ b))
(entmake ent)))))
(princ))
(defun c:tt () ;"编号分解写字"
(setq j -1)
(if (setq ss (ssget '((0 . "text") (1 . "*-*~*"))))
(while (setq s1 (ssname ss (setq j (1+ j))))
(setq tx (xyp-DXF 1 s1))
(setq lst (xyp-StrSprMult tx '("-" "~")))
(setq i (atoi (cadr lst)))
(setq th (xyp-DXF 40 s1))
(xyp-Ctbl (/ th 3.))
(setq qz(car lst)
nn(1+ (- (atoi (caddr lst)) i))
pt(xyp-Pt2X (xyp-9pt s1 6) th)
lst '()
)
(repeat nn
(setq lst (cons (strcat qz "-" (itoa i)) lst)
i (1+ i)
)
)
(xyp-List2Text (reverse lst) 4 pt (* th 1.5))
)
)
(princ)
)
[*](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))
[*])
弥勒 发表于 2024-9-10 11:01
[*];20240910
[*](defun c:zz(/ mystr mystrfg mysort Nstart i Nend pt mystrstrcat)
[*](setvar "c ...
谢谢兄弟........ 夏生生 发表于 2024-9-10 11:02
未测试，仅考虑左对齐text图元
谢谢大哥................ xyp1964 发表于 2024-9-10 13:00
谢谢派大... 统一网名 发表于 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 ( ...
谢谢大哥.....
页:
[1]