社区 › Auto Lisp › 需要紧急更改lisp

blackeagle1245 发表于 2022-7-6 08:46:51

需要紧急更改lisp

嘿伙计们
我需要一个紧急Lisp程序，改变所有的字体的一个字体。例如，dwg中有10种不同的文本样式，但我希望所有这些样式都是罗马文字。
 
提前谢谢。

Lee Mac 发表于 2022-7-6 08:52:11

遍历文档对象的TextStyles集合，并更改每个样式对象的FontFile属性。

blackeagle1245 发表于 2022-7-6 08:54:46

感谢您的快速回复。我发现了这一点，但我怎样才能把它们全部改成浪漫风格呢？有些字体风格保持不变，我认为它们超出了范围。
 
(vl-load-com)

(defun c:updateTextstyles (/ new)
(setq new (strcat (getenv "systemroot") "\\Fonts\\romandtw.shx"))
(vlax-map-collection
(vla-get-textstyles
(vla-get-activedocument
(vlax-get-acad-object)))
'(lambda (x / font)
(setq font (strcase (vla-get-fontfile x)))
(if (wcmatch font "ROMANS.SHX,SIMPLEX.SHX,TXT.SHX")
(vla-put-fontfile x new)))
)
(princ)
)

Tharwat 发表于 2022-7-6 09:01:51

我第一次尝试更改字体测试样式。。。
 

(defun c:Test nil
(vl-load-com)
;; Tharwat 04. 07. 2011
(vlax-for x (vla-get-textstyles
               (vla-get-activedocument (vlax-get-acad-object))
             )
   (if (not (eq (vla-get-fontfile x) "romans.shx"))
   (vlax-put-property x 'fontfile "romans.shx")
   )
)
(vla-regen (vla-get-ActiveDocument (vlax-get-acad-object))
            acAllViewports
)
(princ)
)


 
塔瓦特

blackeagle1245 发表于 2022-7-6 09:04:36

这太完美了，我们可以添加一条线，将宽度因子更改为0.7吗？

Tharwat 发表于 2022-7-6 09:08:48

 

(defun c:ChangeWidth nil
(vl-load-com)
;; Tharwat 05. 07. 2011
(vlax-for x (vla-get-textstyles
               (vla-get-activedocument (vlax-get-acad-object))
             )
   (if (not (eq (vla-get-width x) 0.7))
   (vlax-put-property x 'width 0.7)
   )
)
(vla-regen (vla-get-ActiveDocument (vlax-get-acad-object))
            acAllViewports
)
(princ)
)

 
享受吧，伙计。
 
塔瓦特

blackeagle1245 发表于 2022-7-6 09:12:25

谢谢

Tharwat 发表于 2022-7-6 09:14:13

 
随时欢迎你。
 
塔瓦特

autolisp 发表于 2022-7-6 09:19:45

 
尊敬的先生：，
有一个问题，我想要很少的文本。7和少量文本。9

fab30 发表于 2022-7-6 09:22:28

(defun C:TW ()
(setq p (SSGET "X" '((0 . "TEXT")(8 . "TEXT STYLE NAME"))));CHANGE "TEXT STYLE NAME" TO YOUR TEXT STYLE THAT YOU WANT AT 0.7 WIDTH
(setq nwidth 0.7)                                     ;sets widths equal to 0.7
(if (/= p nil)
(progn
(setq l 0
n (sslength p))
(while (< l n)
(setq e (entget (ssname p l)))
(entmod (setq e(subst (cons 41 nwidth) (assoc 41 e) e))
)
(setq l (1+ l))))
)

;REPEATED FROM ABOVE FOR 0.9 WIDTH
(setq p (SSGET "X" '((0 . "TEXT")(8 . "TEXT STYLE NAME"))));CHANGE"TEXT STYLE NAME" TO YOUR TEXT STYLE THAT YOU WANT AT 0.9 WIDTH
(setq nwidth 0.9)                                     ;sets widths equal to 0.9
(if (/= p nil)
(progn
(setq l 0
n (sslength p))
(while (< l n)
(setq e (entget (ssname p l)))
(entmod (setq e(subst (cons 41 nwidth) (assoc 41 e) e))
)
(setq l (1+ l))))
)
(princ)
)

查看完整版本: 需要紧急更改lisp