需要紧急更改lisp

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

嘿伙计们
我需要一个紧急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") "[url="file://\\Fonts\\romandtw.shx"]\\Fonts\\romandtw.shx[/url]"))
(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

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

copy


(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

copy


(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

copy

(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

发表回复

精选推荐