(CTW)批量修改CAD文字宽度因子
;;说明:批量修改CAD文字宽度因子by <a href="mailto:702099480@qq.com">702099480@qq.com</a>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)))
(if (or (wcmatch str "*`\\W##;*") (wcmatch str "*`\\W#;*") (wcmatch str "*`\\W#.#;*") (wcmatch str "*`\\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)
)
页:
[1]