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

admin1

1. ;;说明:批量修改CAD文字宽度因子  by <a href="mailto:702099480@qq.com">702099480@qq.com</a>  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.             (if (or (wcmatch str "*`\\W##;*") (wcmatch str "*`\\W#;*") (wcmatch str "*`\\W#.#;*") (wcmatch str "*`\\W#.##;*"))
    
15.               (progn
    
16.                 (setq si (1+ (vl-string-search "\\W" str)))
    
17.                 (setq ei (1+ (vl-string-search ";" str (1+ si))))
    
18.                 (setq widstr (substr str si (1+ (- ei si))))
    
19.                 (setq newwidstr (strcat "\\W" (rtos newwid 2 2) ";"))
    
20.                 (setq str (vl-string-subst newwidstr widstr str))
    
21.                 (entmod (subst (cons 1 str) (assoc 1 edata) edata))
    
22.               )
    
23.               (if (wcmatch str "{*}")
    
24.                 (progn
    
25.                   (setq newwidstr (strcat "{\\W" (rtos newwid 2 2) ";"))
    
26.                   (setq str (vl-string-subst newwidstr "{" str))
    
27.                   (entmod (subst (cons 1 str) (assoc 1 edata) edata))
    
28.                 )
    
29.                 (progn
    
30.                   (setq str (strcat "{\\W" (rtos newwid 2 2) ";" str "}"))
    
31.                   (entmod (subst (cons 1 str) (assoc 1 edata) edata))
    
32.                 )
    
33.               )
    
34.             )
    
35.           )
    
36.         )
    
37.       )
    
38.     )
    
39.     (alert "请选择文字对象后再行尝试！")
    
40.   )
    
41.   (prin1)
    
42. )

复制代码