(defun c:TS (/ E ENEW NV P S)
(princ "\n 数字递增复制")
(if (and (setq e (car (entsel "\nSelect Text: ")))
(setq e (vlax-ename->vla-object e))
(or (= "AcDbText" (vla-get-ObjectName e))
(= "AcDbMText" (vla-get-ObjectName e))
)
)
(progn
(setq s (vla-get-TextString e))
(if (null (setq nv (getreal (strcat "\nNew value:" "<1>"))))
(setq nv 1)
)
(princ "\nCopy to: ")
(while (setq p (getpoint))
(setq enew (vla-copy e))
(vla-put-textstring enew (setq s (rtos (+ (atof s) nv) 2)))
(vla-put-InsertionPoint enew (vlax-3d-point p))
)
)
(princ "\n选中的不是文本或没有选择到实体.")
)
(princ)
)
(DEFUN C:01 ()
(princ "\nSet object's LAYER to layer0:")
(princ "\n 选择对象到0层:)")
(SETQ SS(SSGET))
(COMMAND "CHANGE" SS "" "PROPERTIES" "la" "layer0" "")
(PRINC))
;;;
电脑内字体少而打开别人的图纸字体特别多怎么办?在文字样式中一个一个修改,这当然麻烦,送一个;;自编的小程序给你。这种又没技术含量又很烦的修改让电脑去做吧。
(defun c:fft (/ elist nm en cn enl)
(setq elist (tblnext "STYLE" T))
(while (/= elist nil)
(setq nm (cdr (assoc 2 elist))
en (cdr (assoc 3 elist))
cn (cdr (assoc 4 elist))
enl (strlen en)
)
(if (and
(/= en nil)
(= cn nil)
(= (findfile en) nil)
(= (strcase (substr en (- enl 2))) "SHX")
)
(command "_style" nm "romans.shx" "0.0" "0.8" "" "" "" "")
)
(if (and
(/= cn nil)
(= (findfile cn) nil)
)
(command "_style" nm "romans.shx,hztxt.shx" "0.0" "0.8" "" "" "" "")
)
(setq elist (tblnext "STYLE"))
)
)