改字体为当前样式

Gray-wolf

(defun c:ztt (/ acaddocument acadobject currtextstyle e hi n obj ss)
    (setvar "cmdecho" 0)
    (setq ss (ssget '((0 . "TEXT"))))
    (setq AcadObject  (vlax-get-acad-object)  
        　　AcadDocument (vla-get-ActiveDocument AcadObject)         
    )  
    (setq currTextStyle(vla-get-ActiveTextStyle AcadDocument))  
    (princ "当前的文字样式是: ")(princ (vla-get-name currTextStyle))  
    ;;; 将文字样式设定为新的文字样式  
    (setq hi (vla-get-Height currtextstyle))
   
  (setq n 0)
  (repeat (sslength ss)
    (setq e (ssname ss n))
        (setq obj (vlax-ename->vla-object e))
        (vla-put-StyleName obj (vla-get-name currTextStyle))
        (vla-put-Height obj hi)        
        (vla-Update obj)
        (setq n (1+ n))
    )
    (setvar "cmdecho" 1)
    (princ)
);defun_end

yoyoho

谢谢! Gray-wolf 分享程序!!!!

xcmdos

这个论坛上已有