(CTW)批量修改CAD文字宽度因子2024.4.17

fangmin723 · 发表于 2024-4-8 14:59:19

本帖最后由 fangmin723 于 2024-4-17 08:12 编辑
单行文字的宽度因子好说，直接在属性面板中可批量修改。

但是多行文字的话，不知道能否通过文字样式批量修改，为了修改多行文字样式而去创建文字样式，未免过于繁琐。

通常情况下只能一个个进入文字格式编辑器中修改，也过于麻烦，于是就有了批量修改文字宽度因子的想法，并实现！

代码如下：

;;说明:批量修改CAD文字宽度因子 by 702099480 @ q q . com 2023.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)
)

;;说明:批量修改CAD文字宽度因子  by 702099480 @ q q . com  2023.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 . com 2023.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)
)

;;说明:批量修改CAD文字宽度因子  by 702099480 @ q q . com  2023.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 . com 2023.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)
)

;;说明:批量修改CAD文字宽度因子  by 702099480 @ q q . com  2023.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) 
)

应部分人要求，上传源码文件：文件内代码和上面给出代码一样

sammy · 发表于 2024-4-9 18:51:25

szhorse 发表于 2024-4-9 13:15
很给力，贪心一下，有没有类似的批量修改单行文字对正方式的吗？
碰到一些人得图，单行文字中对正方式为布 ...

cad有原生命令justfytext

fangmin723 · 发表于 2024-4-8 15:31:32

本帖最后由 fangmin723 于 2024-4-8 15:35 编辑

lxl217114 发表于 2024-4-8 15:18
大佬可以做到给用了某个样式的单行文字，全部按样式的宽度么？
http://bbs.mjtd.com/thread-189767-1-1.ht ...

给你个思路，首先获取样式的属性，然后获取样式设置的宽度因子，然后，拾取使用了该样式的所有文字，然后循环遍历更改宽度因子

还可以直接用程序获取改样式的所有单行文字，进行亮显，然后手动在属性面板中更改

还有就是通过CAD自带的快速选择命令QSELECT，来批量选择

fangmin723 · 发表于 2024-4-9 11:43:50

Noangler 发表于 2024-4-9 11:20
如图所示，以前有宽度属性的，再执行CTW出现两个宽度属性在里面，文字宽度没有改变。

已给出的代码里只能匹配两位小数点，如果想要匹配四位，直接在增加匹配项即可

(wcmatch str "*`\\W##;*,*`\\W#;*,*`\\W#.#;*,*`\\W#.##;*,*`\\W#.###;*,*`\\W#.####;*")

zhangrunze · 发表于 2024-4-8 15:10:41

不错呢~感谢分享源码。
学习了~！

lzspain · 发表于 2024-4-8 15:11:08

好东西，平时改图面被多行文字整惨了，这些终于也可以批量修改了，感谢大佬！

lxl217114 · 发表于 2024-4-8 15:16:07

谢谢大佬分享

lxl217114 · 发表于 2024-4-8 15:18:17

大佬可以做到给用了某个样式的单行文字，全部按样式的宽度么？
http://bbs.mjtd.com/thread-189767-1-1.html

fangmin723 · 发表于 2024-4-8 15:24:18

lxl217114 发表于 2024-4-8 15:18
大佬可以做到给用了某个样式的单行文字，全部按样式的宽度么？
http://bbs.mjtd.com/thread-189767-1-1.ht ...

理论上可以啊，但是还得看实践

你有种再说一遍 · 发表于 2024-4-8 15:34:00

哈哈,你为了国产cad又要跑去敲lisp

fangmin723 · 发表于 2024-4-8 15:39:01

你有种再说一遍发表于 2024-4-8 15:34
哈哈,你为了国产cad又要跑去敲lisp

哈哈哈，都是去年写的，我现在都乱套了，写的太多了，又不是经常用，一到用的时候就忘了是啥命令，所以等不忙不的时候弄成.NET

lxl217114 · 发表于 2024-4-8 16:34:55

fangmin723 发表于 2024-4-8 15:31
给你个思路，首先获取样式的属性，然后获取样式设置的宽度因子，然后，拾取使用了该样式的所有文字，然后 ...

用选择易类的方法是知道的，就是想偷懒，哈哈哈。
谢谢大佬赐教

账号		自动登录	找回密码
密码			注册

[源码] (CTW)批量修改CAD文字宽度因子2024.4.17

本帖子中包含更多资源

评分

相关帖子

本帖子中包含更多资源