2015年12月15日 09:15:31

10楼

(princ "\n命令：tx 改变字体文件！")

(defun c:tx (/ acaddocument tstyle textitem textcont seltext i textsel

texti)

(vl-load-com)

(setq acaddocument (vla-get-activedocument (vlax-get-acad-object)))

(setq tstyle (vla-get-textstyles acaddocument))

(vla-add tstyle "CXB_txt")

(setq textitem (vla-item tstyle "CXB_txt"))

(vla-put-fontfile textitem "gbenor.shx") ;"romans.shx"

(vla-put-bigfontfile textitem "GBCBIG.shx") ;"hztc2.shx"

(vla-put-width textitem 1)

(vla-put-height textitem 0.0)

(prompt "\n点选需转换的字体：")

(setq seltext (vlax-ename->vla-object (car (entsel))))

(setq selstyle (vla-get-stylename seltext))

(if (wcmatch selstyle "[@#]*")

(progn

(setq selstyle (strcat "[@#]" (substr selstyle 2)))

;;;(vla-put-stylename (vla-item tstyle (vla-get-stylename seltext)) selstyle )

))

(setq textsel

(ssget "_x" (list (cons 0 "TEXT,ATTDEF") (cons 7 selstyle)))

)

(setq i 0)

(repeat (sslength textsel)

(setq texti (vlax-ename->vla-object (ssname textsel i)))

(vla-put-stylename texti "CXB_txt")

(vla-put-scalefactor texti 1)

;;; (vla-put-height

;;; texti

;;; (* 100 (fix (/ (vla-get-height texti) 100)))

;;; )

;;; (if (= (vla-get-height texti) 200)

;;; (vla-put-height texti 300)

;;; )

(setq i (1+ i))

)

;;(vla-regen acadDocument acallViewports)

(vla-regen acadDocument :vlax-true)

(princ)

)

回复