(CTW)批量修改CAD文字宽度因子2024.4.17
本帖最后由 fangmin723 于 2024-4-17 08:12 编辑单行文字的宽度因子好说，直接在属性面板中可批量修改。
但是多行文字的话，不知道能否通过文字样式批量修改，为了修改多行文字样式而去创建文字样式，未免过于繁琐。
通常情况下只能一个个进入文字格式编辑器中修改，也过于麻烦，于是就有了批量修改文字宽度因子的想法，并实现！
代码如下：
;;说明:批量修改CAD文字宽度因子by 702099480 @ q q . com2023.3.29
(defun C:CTW(/ edata ei ent n newwid newwidstr si ss str tpy widstr)
(if (setq ss (ssget '((0 . "*TEXT"))))
(progn
(if (= nil (setq newwid (getreal "\n 请输入新的文字宽度因子，默认<0.7>："))) (setq newwid 0.7))
(if (> newwid 10) (setq newwid 10.0))
(setq n -1)
(while (setq ent (ssname ss (setq n (1+ n))))
(setq edata (entget ent) tpy (cdr (assoc 0 edata)))
(if (equal tpy "TEXT")
(entmod (subst (cons 41 newwid) (assoc 41 edata) edata))
(progn
(setq str (cdr (assoc 1 edata)))
;;2024.4.9修改匹配项至小数点后四位
(if (wcmatch str "*`\\W##;*,*`\\W#;*,*`\\W#.#;*,*`\\W#.##;*,*`\\W#.###;*,*`\\W#.####;*")
(progn
(setq si (1+ (vl-string-search "\\W" str)))
(setq ei (1+ (vl-string-search ";" str (1+ si))))
(setq widstr (substr str si (1+ (- ei si))))
(setq newwidstr (strcat "\\W" (rtos newwid 2 2) ";"))
(setq str (vl-string-subst newwidstr widstr str))
(entmod (subst (cons 1 str) (assoc 1 edata) edata))
)
(if (wcmatch str "{*}")
(progn
(setq newwidstr (strcat "{\\W" (rtos newwid 2 2) ";"))
(setq str (vl-string-subst newwidstr "{" str))
(entmod (subst (cons 1 str) (assoc 1 edata) edata))
)
(progn
(setq str (strcat "{\\W" (rtos newwid 2 2) ";" str "}"))
(entmod (subst (cons 1 str) (assoc 1 edata) edata))
)
)
)
)
)
)
)
(alert "请选择文字对象后再行尝试！")
)
(prin1)
)
(常规方式修改) 多行文字存在多个宽度因子时统一修改为输入值 2024.4.17
;;说明:批量修改CAD文字宽度因子by 702099480 @ q q . com2023.3.29
;; 多行文字存在多个宽度因子时统一修改为输入值 (常规方式修改) 2024.4.17
(defun C:CTW(/ edata ei endstr ent ischanged n newwid newwidstr si ss str tpy widstr)
(if (setq ss (ssget '((0 . "*TEXT"))))
(progn
(if (= nil (setq newwid (getreal "\n 请输入新的文字宽度因子，默认<0.7>："))) (setq newwid 0.7))
(if (> newwid 10) (setq newwid 10.0))
(setq n -1)
(while (setq ent (ssname ss (setq n (1+ n))))
(setq edata (entget ent) tpy (cdr (assoc 0 edata)))
(if (equal tpy "TEXT")
(entmod (subst (cons 41 newwid) (assoc 41 edata) edata))
(progn
(setq endstr (cdr (assoc 1 edata)) si 1 ei (strlen endstr) str "" ischanged nil)
;;2024.4.9修改匹配项至小数点后四位
(while (wcmatch endstr "*`\\W##;*,*`\\W#;*,*`\\W#.#;*,*`\\W#.##;*,*`\\W#.###;*,*`\\W#.####;*")
(setq si (1+ (vl-string-search "\\W" endstr)))
(setq ei (1+ (vl-string-search ";" endstr (1+ si))))
(setq widstr (substr endstr si (1+ (- ei si))))
(setq newwidstr (strcat "\\W" (rtos newwid 2 2) ";"))
(setq str (strcat str (substr endstr 1 ei)))
(setq str (vl-string-subst newwidstr widstr str))
(setq endstr (substr endstr (1+ ei)))
(setq ischanged t)
)
(if (null ischanged)
(if (wcmatch str "{*}")
(progn
(setq newwidstr (strcat "{\\W" (rtos newwid 2 2) ";"))
(setq str (vl-string-subst newwidstr "{" str))
(entmod (subst (cons 1 str) (assoc 1 edata) edata))
)
(progn
(setq str (strcat "{\\W" (rtos newwid 2 2) ";" str "}"))
(entmod (subst (cons 1 str) (assoc 1 edata) edata))
)
)
(progn
(setq str (strcat str endstr))
(entmod (subst (cons 1 str) (assoc 1 edata) edata))
)
)
)
)
)
)
(alert "请选择文字对象后再行尝试！")
)
(prin1)
)
(正则方式修改) 多行文字存在多个宽度因子时统一修改为输入值 2024.4.17
;;说明:批量修改CAD文字宽度因子by 702099480 @ q q . com2023.3.29
;; 多行文字存在多个宽度因子时统一修改为输入值 (正则方式修改) 2024.4.17
(defun C:CTW(/ edata ent mat n newwid newwidstr reg ss str tpy)
(if (setq ss (ssget '((0 . "*TEXT"))))
(progn
(if (= nil (setq newwid (getreal "\n 请输入新的文字宽度因子，默认<0.7>："))) (setq newwid 0.7))
(if (> newwid 10) (setq newwid 10.0))
(setq reg (vlax-create-object "vbscript.regexp")) ;创建正则表达式
(vlax-put-property reg 'global 1) ;是否匹配全部
(vlax-put-property reg 'Multiline 1);是否多行匹配
(vlax-put-property reg 'IgnoreCase 1);是否忽略大小写
(setq n -1)
(while (setq ent (ssname ss (setq n (1+ n))))
(setq edata (entget ent) tpy (cdr (assoc 0 edata)))
(if (equal tpy "TEXT")
(entmod (subst (cons 41 newwid) (assoc 41 edata) edata))
(progn
(setq str (cdr (assoc 1 edata)))
(vlax-put-property reg 'Pattern "\\\\W\\d+\.?\\d*;")
(setq mat (vlax-invoke reg 'Execute str))
(if (> (vlax-get-property mat 'count) 0)
(progn
(setq newwidstr (strcat "\\W" (rtos newwid 2 2) ";"))
(vlax-for x mat
(vlax-put-property reg 'Pattern (strcat "\\" (vla-get-value x)))
(setq str (vlax-invoke reg 'Replace str newwidstr))
)
(entmod (subst (cons 1 str) (assoc 1 edata) edata))
)
(if (wcmatch str "{*}")
(progn
(setq newwidstr (strcat "{\\W" (rtos newwid 2 2) ";"))
(setq str (vl-string-subst newwidstr "{" str))
(entmod (subst (cons 1 str) (assoc 1 edata) edata))
)
(progn
(setq str (strcat "{\\W" (rtos newwid 2 2) ";" str "}"))
(entmod (subst (cons 1 str) (assoc 1 edata) edata))
)
)
)
)
)
)
(vlax-release-object mat)
(vlax-release-object reg)
)
(alert "请选择文字对象后再行尝试！")
)
(prin1)
)
应部分人要求，上传源码文件：文件内代码和上面给出代码一样
szhorse 发表于 2024-4-9 13:15
很给力，贪心一下，有没有类似的批量修改单行文字对正方式的吗？
碰到一些人得图，单行文字中对正方式为布 ...
cad有原生命令justfytext 本帖最后由 fangmin723 于 2024-4-8 15:35 编辑
lxl217114 发表于 2024-4-8 15:18
大佬可以做到给用了某个样式的单行文字，全部按样式的宽度么？
http://bbs.mjtd.com/thread-189767-1-1.ht ...
给你个思路，首先获取样式的属性，然后获取样式设置的宽度因子，然后，拾取使用了该样式的所有文字，然后循环遍历更改宽度因子
还可以直接用程序获取改样式的所有单行文字，进行亮显，然后手动在属性面板中更改
还有就是通过CAD自带的快速选择命令QSELECT，来批量选择
Noangler 发表于 2024-4-9 11:20
如图所示，以前有宽度属性的，再执行CTW出现两个宽度属性在里面，文字宽度没有改变。
已给出的代码里只能匹配两位小数点，如果想要匹配四位，直接在增加匹配项即可
(wcmatch str "*`\\W##;*,*`\\W#;*,*`\\W#.#;*,*`\\W#.##;*,*`\\W#.###;*,*`\\W#.####;*") 不错呢~感谢分享源码。
学习了~！ 好东西，平时改图面被多行文字整惨了，这些终于也可以批量修改了，感谢大佬！ 谢谢大佬分享 大佬可以做到给用了某个样式的单行文字，全部按样式的宽度么？
http://bbs.mjtd.com/thread-189767-1-1.html lxl217114 发表于 2024-4-8 15:18
大佬可以做到给用了某个样式的单行文字，全部按样式的宽度么？
http://bbs.mjtd.com/thread-189767-1-1.ht ...
理论上可以啊，但是还得看实践 哈哈,你为了国产cad又要跑去敲lisp 你有种再说一遍 发表于 2024-4-8 15:34
哈哈,你为了国产cad又要跑去敲lisp
哈哈哈，都是去年写的，我现在都乱套了，写的太多了，又不是经常用，一到用的时候就忘了是啥命令，所以等不忙不的时候弄成.NET fangmin723 发表于 2024-4-8 15:31
给你个思路，首先获取样式的属性，然后获取样式设置的宽度因子，然后，拾取使用了该样式的所有文字，然后 ...
用选择易类的方法是知道的，就是想偷懒，哈哈哈。
谢谢大佬赐教