明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1343|回复: 34

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

  [复制链接]
发表于 2024-4-8 14:59 | 显示全部楼层 |阅读模式
本帖最后由 fangmin723 于 2024-4-17 08:12 编辑
单行文字的宽度因子好说,直接在属性面板中可批量修改。


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


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


代码如下:
  1. ;;说明:批量修改CAD文字宽度因子  by 702099480 @ q q . com  2023.3.29
  2. (defun C:CTW(/ edata ei ent n newwid newwidstr si ss str tpy widstr)
  3.   (if (setq ss (ssget '((0 . "*TEXT"))))
  4.     (progn
  5.       (if (= nil (setq newwid (getreal "\n 请输入新的文字宽度因子,默认<0.7>:"))) (setq newwid 0.7))
  6.       (if (> newwid 10) (setq newwid 10.0))
  7.       (setq n -1)
  8.       (while (setq ent (ssname ss (setq n (1+ n))))
  9.         (setq edata (entget ent) tpy (cdr (assoc 0 edata)))
  10.         (if (equal tpy "TEXT")
  11.           (entmod (subst (cons 41 newwid) (assoc 41 edata) edata))
  12.           (progn
  13.             (setq str (cdr (assoc 1 edata)))
  14.             ;;2024.4.9修改匹配项至小数点后四位
  15.             (if (wcmatch str "*`\\W##;*,*`\\W#;*,*`\\W#.#;*,*`\\W#.##;*,*`\\W#.###;*,*`\\W#.####;*")
  16.               (progn
  17.                 (setq si (1+ (vl-string-search "\\W" str)))
  18.                 (setq ei (1+ (vl-string-search ";" str (1+ si))))
  19.                 (setq widstr (substr str si (1+ (- ei si))))
  20.                 (setq newwidstr (strcat "\\W" (rtos newwid 2 2) ";"))
  21.                 (setq str (vl-string-subst newwidstr widstr str))
  22.                 (entmod (subst (cons 1 str) (assoc 1 edata) edata))
  23.               )
  24.               (if (wcmatch str "{*}")
  25.                 (progn
  26.                   (setq newwidstr (strcat "{\\W" (rtos newwid 2 2) ";"))
  27.                   (setq str (vl-string-subst newwidstr "{" str))
  28.                   (entmod (subst (cons 1 str) (assoc 1 edata) edata))
  29.                 )
  30.                 (progn
  31.                   (setq str (strcat "{\\W" (rtos newwid 2 2) ";" str "}"))
  32.                   (entmod (subst (cons 1 str) (assoc 1 edata) edata))
  33.                 )
  34.               )
  35.             )
  36.           )
  37.         )
  38.       )
  39.     )
  40.     (alert "请选择文字对象后再行尝试!")
  41.   )
  42.   (prin1)
  43. )


(常规方式修改) 多行文字存在多个宽度因子时统一修改为输入值 2024.4.17
  1. ;;说明:批量修改CAD文字宽度因子  by 702099480 @ q q . com  2023.3.29
  2. ;;     多行文字存在多个宽度因子时统一修改为输入值 (常规方式修改) 2024.4.17
  3. (defun C:CTW(/ edata ei endstr ent ischanged n newwid newwidstr si ss str tpy widstr)
  4.   (if (setq ss (ssget '((0 . "*TEXT"))))
  5.     (progn
  6.       (if (= nil (setq newwid (getreal "\n 请输入新的文字宽度因子,默认<0.7>:"))) (setq newwid 0.7))
  7.       (if (> newwid 10) (setq newwid 10.0))
  8.       (setq n -1)
  9.       (while (setq ent (ssname ss (setq n (1+ n))))
  10.         (setq edata (entget ent) tpy (cdr (assoc 0 edata)))
  11.         (if (equal tpy "TEXT")
  12.           (entmod (subst (cons 41 newwid) (assoc 41 edata) edata))
  13.           (progn
  14.             (setq endstr (cdr (assoc 1 edata)) si 1 ei (strlen endstr) str "" ischanged nil)
  15.             ;;2024.4.9修改匹配项至小数点后四位
  16.             (while (wcmatch endstr "*`\\W##;*,*`\\W#;*,*`\\W#.#;*,*`\\W#.##;*,*`\\W#.###;*,*`\\W#.####;*")
  17.               (setq si (1+ (vl-string-search "\\W" endstr)))
  18.               (setq ei (1+ (vl-string-search ";" endstr (1+ si))))
  19.               (setq widstr (substr endstr si (1+ (- ei si))))
  20.               (setq newwidstr (strcat "\\W" (rtos newwid 2 2) ";"))
  21.               (setq str (strcat str (substr endstr 1 ei)))
  22.               (setq str (vl-string-subst newwidstr widstr str))
  23.               (setq endstr (substr endstr (1+ ei)))
  24.               (setq ischanged t)
  25.             )
  26.             (if (null ischanged)
  27.               (if (wcmatch str "{*}")
  28.                 (progn
  29.                   (setq newwidstr (strcat "{\\W" (rtos newwid 2 2) ";"))
  30.                   (setq str (vl-string-subst newwidstr "{" str))
  31.                   (entmod (subst (cons 1 str) (assoc 1 edata) edata))
  32.                 )
  33.                 (progn
  34.                   (setq str (strcat "{\\W" (rtos newwid 2 2) ";" str "}"))
  35.                   (entmod (subst (cons 1 str) (assoc 1 edata) edata))
  36.                 )
  37.               )
  38.               (progn
  39.                 (setq str (strcat str endstr))
  40.                 (entmod (subst (cons 1 str) (assoc 1 edata) edata))
  41.               )
  42.             )
  43.           )
  44.         )
  45.       )
  46.     )
  47.     (alert "请选择文字对象后再行尝试!")
  48.   )
  49.   (prin1)
  50. )


(正则方式修改) 多行文字存在多个宽度因子时统一修改为输入值 2024.4.17
  1. ;;说明:批量修改CAD文字宽度因子  by 702099480 @ q q . com  2023.3.29
  2. ;;     多行文字存在多个宽度因子时统一修改为输入值 (正则方式修改) 2024.4.17
  3. (defun C:CTW(/ edata ent mat n newwid newwidstr reg ss str tpy)
  4.   (if (setq ss (ssget '((0 . "*TEXT"))))
  5.     (progn
  6.       (if (= nil (setq newwid (getreal "\n 请输入新的文字宽度因子,默认<0.7>:"))) (setq newwid 0.7))
  7.       (if (> newwid 10) (setq newwid 10.0))
  8.       (setq reg (vlax-create-object "vbscript.regexp")) ;创建正则表达式
  9.       (vlax-put-property reg 'global 1) ;是否匹配全部
  10.       (vlax-put-property reg 'Multiline 1);是否多行匹配
  11.       (vlax-put-property reg 'IgnoreCase 1);是否忽略大小写
  12.       (setq n -1)
  13.       (while (setq ent (ssname ss (setq n (1+ n))))
  14.         (setq edata (entget ent) tpy (cdr (assoc 0 edata)))
  15.         (if (equal tpy "TEXT")
  16.           (entmod (subst (cons 41 newwid) (assoc 41 edata) edata))
  17.           (progn
  18.             (setq str (cdr (assoc 1 edata)))
  19.             (vlax-put-property reg 'Pattern "\\\\W\\d+\.?\\d*;")
  20.             (setq mat (vlax-invoke reg 'Execute str))
  21.             (if (> (vlax-get-property mat 'count) 0)
  22.               (progn
  23.                 (setq newwidstr (strcat "\\W" (rtos newwid 2 2) ";"))
  24.                 (vlax-for x mat
  25.                   (vlax-put-property reg 'Pattern (strcat "\\" (vla-get-value x)))
  26.                   (setq str (vlax-invoke reg 'Replace str newwidstr))
  27.                 )
  28.                 (entmod (subst (cons 1 str) (assoc 1 edata) edata))
  29.               )
  30.               (if (wcmatch str "{*}")
  31.                 (progn
  32.                   (setq newwidstr (strcat "{\\W" (rtos newwid 2 2) ";"))
  33.                   (setq str (vl-string-subst newwidstr "{" str))
  34.                   (entmod (subst (cons 1 str) (assoc 1 edata) edata))
  35.                 )
  36.                 (progn
  37.                   (setq str (strcat "{\\W" (rtos newwid 2 2) ";" str "}"))
  38.                   (entmod (subst (cons 1 str) (assoc 1 edata) edata))
  39.                 )
  40.               )
  41.             )
  42.           )
  43.         )
  44.       )
  45.       (vlax-release-object mat)
  46.       (vlax-release-object reg)
  47.     )
  48.     (alert "请选择文字对象后再行尝试!")
  49.   )
  50.   (prin1)
  51. )

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

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x

评分

参与人数 4明经币 +4 收起 理由
sammy + 1 赞一个!升级版!
hubeiwdlue + 1 赞一个!
菜鸟初来乍到 + 1 很给力!
zhoupeng220 + 1 很给力!

查看全部评分

"觉得好,就打赏"
还没有人打赏,支持一下
发表于 2024-4-9 18:51 | 显示全部楼层
szhorse 发表于 2024-4-9 13:15
很给力,贪心一下,有没有类似的批量修改单行文字对正方式的吗?
碰到一些人得图,单行文字中对正方式为布 ...

cad有原生命令justfytext
回复 支持 1 反对 0

使用道具 举报

 楼主| 发表于 2024-4-8 15:31 | 显示全部楼层
本帖最后由 fangmin723 于 2024-4-8 15:35 编辑
lxl217114 发表于 2024-4-8 15:18
大佬可以做到给用了某个样式的单行文字,全部按样式的宽度么?
http://bbs.mjtd.com/thread-189767-1-1.ht ...

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

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

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

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
 楼主| 发表于 2024-4-9 11:43 | 显示全部楼层
Noangler 发表于 2024-4-9 11:20
如图所示,以前有宽度属性的,再执行CTW出现两个宽度属性在里面,文字宽度没有改变。

已给出的代码里只能匹配两位小数点,如果想要匹配四位,直接在增加匹配项即可
  1. (wcmatch str "*`\\W##;*,*`\\W#;*,*`\\W#.#;*,*`\\W#.##;*,*`\\W#.###;*,*`\\W#.####;*")
发表于 2024-4-8 15:10 | 显示全部楼层
不错呢~感谢分享源码。
学习了~!
发表于 2024-4-8 15:11 | 显示全部楼层
好东西,平时改图面被多行文字整惨了,这些终于也可以批量修改了,感谢大佬!
发表于 2024-4-8 15:16 | 显示全部楼层
谢谢大佬分享
发表于 2024-4-8 15:18 | 显示全部楼层
大佬可以做到给用了某个样式的单行文字,全部按样式的宽度么?
http://bbs.mjtd.com/thread-189767-1-1.html
 楼主| 发表于 2024-4-8 15:24 | 显示全部楼层
lxl217114 发表于 2024-4-8 15:18
大佬可以做到给用了某个样式的单行文字,全部按样式的宽度么?
http://bbs.mjtd.com/thread-189767-1-1.ht ...

理论上可以啊,但是还得看实践
发表于 2024-4-8 15:34 | 显示全部楼层
哈哈,你为了国产cad又要跑去敲lisp
 楼主| 发表于 2024-4-8 15:39 | 显示全部楼层
你有种再说一遍 发表于 2024-4-8 15:34
哈哈,你为了国产cad又要跑去敲lisp

哈哈哈,都是去年写的,我现在都乱套了,写的太多了,又不是经常用,一到用的时候就忘了是啥命令,所以等不忙不的时候弄成.NET
发表于 2024-4-8 16:34 | 显示全部楼层
fangmin723 发表于 2024-4-8 15:31
给你个思路,首先获取样式的属性,然后获取样式设置的宽度因子,然后,拾取使用了该样式的所有文字,然后 ...


用选择易类的方法是知道的,就是想偷懒,哈哈哈。
谢谢大佬赐教
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-5-19 04:37 , Processed in 0.190419 second(s), 34 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表