在此处更正代码-帮助
尊敬的各位：，请更正最后一行的代码，将宽度更新为“（vlax put property lay’width（*0.75 width\u old））”。
请帮忙。
(defun style_change_to_avoid_bug_in_text_Selection (/ get->styleobj a width_old)
(defun get->styleobj () (vla-get-textstyles (vla-get-ActiveDocument (vlax-get-acad-object))))
(vlax-for lay (get->styleobj)
(Setq a (strcase (vlax-get-property lay 'FontFile)))
(if (= (substr a (- (strlen a) 2) (strlen a)) "TTF")
(progn (Setq name_Style (vlax-get-property lay 'Name))
(setq width_old (vlax-get-property lay 'width))
(vlax-put-property lay 'FontFile "romand.shx")
(vlax-put-property lay 'width (* 0.75 width_old) )
;;;(vlax-put-property lay 'width (rtos (* 0.75 width_old) 2 2))
)
)
)
(command "regen")
) 这似乎对我有用：
(defun test ( / a name_style width_old)
(vlax-for sty (vla-get-textstyles
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object))))
(setq a (strcase (vlax-get-property sty 'FontFile)))
(if (eq (substr a (- (strlen a) 2)) "TTF")
(progn
(setq name_Style (vlax-get-property sty 'Name))
(setq width_old(vlax-get-property sty 'width))
(vlax-put-property sty 'FontFile "romand.shx")
(vlax-put-property sty 'width (* 0.75 width_old))
)
)
)
(vla-regen doc acActiveViewport)
(princ)
)
谢谢李修改我的代码。我想在下面的代码也这样。请帮忙，你还有其他逻辑来完成这项任务吗？
(defun style_change (/ a name_style width_old)
(vlax-for sty (vla-get-textstyles (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))))
(setq a (strcase (vlax-get-property sty 'FontFile)))
(if (eq (substr a (- (strlen a) 2)) "TTF")
(progn (setq name_Style (vlax-get-property sty 'Name))
(setq width_old (vlax-get-property sty 'width))
(vlax-put-property sty 'FontFile "romand.shx")
(Setq sset (ssget "x" (list (cons 7 name_Style))))
(Setq #k 0)
(repeat (sslength sset)
(Setq ename (ssname sset #k))
(Setq vlobj (vlax-ename->vla-object ename))
(if (vlax-property-available-p vlobj 'width)
(vla-put-width vlobj (* 0.75 width_old))
(vla-put-scalefactor vlobj (* 0.75 width_old))
)
(Setq #k (1+ #k))
)
)
)
)
(vla-regen doc acActiveViewport)
(princ)
)
页:
[1]