综合炸开清理【程序出错】
本帖最后由 尘缘一生 于 2018-6-28 13:00 编辑2018版，不能使用，错误提示如下：
调用(*push-error-using-command*)前无法从 *error* 调用(command)。
建议将(command)调用转换为(command-s)。
命令:
请高手分析下，哪里原因？
;;---炸开清理全图-------------------------------------------------------------------------
(defun C:T-EXPLODE(/ s p n l nam stlx r_zm70 c_zm71 r_dist_zm44 c_dist_zm45 e)
;; 炸开属性块，属性转文字
(setq s nil)
(if (setq s(ssget "X" (list (cons 0 "INSERT")(cons 66 1))))
(progn
(vl-load-com)
(setq p(sslength s))
(setq n 0 )
(undobegin)
(setq p(- p 1))
(while (<= n p)
(a2t (ssname s n))
(setq n (+ n 1))
(undoend)
)
)
)
;;转多重插入块为普通快
(setvar "cmdecho" 0)
(setq s nil)
(if (setq s(ssget "X" (list (cons 0 "INSERT")(cons 100 "AcDbMInsertBlock"))))
(progn
(setq p(sslength s))
(setq n 0 )
(setq p (- p 1))
(while (<= n p)
(setq nam(ssname s n))
(setq e (entget nam))
(setq stlx (cdr (assoc 0 e)))
(setq r_zm70 (assoc 70 e))
(setq c_zm71 (assoc 71 e))
(setq r_dist_zm44 (assoc 44 e))
(setq c_dist_zm45 (assoc 45 e))
(setq e (subst (cons 44 0) r_dist_zm44 e))
(setq e (subst (cons 45 0) c_dist_zm45 e))
(setq e (subst (cons 70 0) r_zm70 e))
(setq e (subst (cons 71 0) c_zm71 e))
(setq e (subst (list 100 "AcDbBlockReference") (list 100 "AcDbMInsertBlock") e))
(entmake e)
(entdel nam)
(setq n (+ n 1))
)
)
)
;; 炸开存在普通块、MTEXT字体，，，，，，，，，，
(setq s nil)
(if (setq s(ssget "X" (list (cons 0 "MTEXT,DIM*,TCH*,INSERT"))))
(progn
(setq p(sslength s))
(setq n 0 )
(setq p (- p 1))
(while (<= n p)
(setq nam(ssname s n))
(command "EXPLODE" nam "")
(setq n (+ n 1))
)
)
)
(setvar "cmdecho" 1)
(command "_.PURGE" "a" "*" "N")
(csh)
(command "-scalelistedit" "R" "Y" "E") ;;清理注释比例
(command "regenall")
)
;;; ***********************************************************************
;;以下是属性转文字函数
(defun undobegin ()
(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
)
;;--------------------------------------------------------------
(defun undoend ()
(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
)
;;--------------------------------------------------------------
(defun dxf (code elist)
(cdr (assoc code elist))
)
;;--------------------------------------------------------------
(defun makeobject (obj)
(cond
((= (type obj) 'vla-object)
obj
)
((= (type obj) 'ename)
(vlax-ename->vla-object obj)
)
)
)
;;--------------------------------------------------------------
(defun explode1 (obj / temp)
(setq temp (vla-explode obj))
(vla-delete obj)
temp
)
;;--------------------------------------------------------------
(defun vararray->list (vaobj)
(vlax-safearray->list (vlax-variant-value vaobj))
)
;;--------------------------------------------------------------
(defun a2t (obj / attlist attobj txt txtpt just inspt height width rot genflag layr ent idx objlist style space tmp upsid bkwd ltyp
colr attlyr attcol
)
(if (and
(= (dxf 0 (entget obj)) "INSERT")
(setq obj (makeobject obj))
)
(if (= (vla-get-hasattributes obj) :vlax-true)
(progn
(setq attlist (vararray->list (vla-getattributes obj))
idx 0
layr (vla-get-layer obj)
ltyp (vla-get-linetype obj)
colr (vla-get-color obj)
)
(repeat (length attlist)
(setq attobj (nth idx attlist)
txt (append
txt
(list (vla-get-textstring attobj))
)
txtpt (append
txtpt
(list (vla-get-textalignmentpoint attobj))
)
inspt (append
inspt
(list (vla-get-insertionpoint attobj))
)
just (append
just
(list (vla-get-alignment attobj))
)
height (append
height
(list (vla-get-height attobj))
)
width (append
width
(list (vla-get-scalefactor attobj))
)
rot (append
rot
(list (vla-get-rotation attobj))
)
style (append
style
(list (vla-get-stylename attobj))
)
upsid (append
upsid
(list (vla-get-upsidedown attobj))
)
bkwd (append
bkwd
(list (vla-get-backward attobj))
)
attlyr (append
attlyr
(list (vla-get-layer attobj))
)
attcol (append
attcol
(list (vla-get-color attobj))
)
idx (1+ idx)
)
)
(setq objlist (vararray->list (explode1 obj))
idx 0
)
(repeat (length objlist)
(setq ent (dxf 0 (entget (vlax-vla-object->ename (nth idx objlist)))))
(if (= ent "ATTDEF")
(vla-erase (nth idx objlist))
(if (= (vla-get-layer (nth idx objlist)) "0")
(progn
(vla-put-layer (nth idx objlist) layr)
(vla-put-linetype (nth idx objlist) ltyp)
(vla-put-color (nth idx objlist) colr)
)
)
)
(setq idx (1+ idx))
)
(setq space (if (= (vla-get-activespace (vla-get-activedocument (vlax-get-acad-object))) acmodelspace)
(vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
(vla-get-paperspace (vla-get-activedocument (vlax-get-acad-object)))
)
idx 0
)
(repeat (length attlist)
(setq tmp (vla-addtext space (nth idx txt) (nth idx inspt) (nth idx height)))
(vla-put-alignment tmp (nth idx just))
(if (and
(/= (nth idx just) acalignmentleft)
(/= (nth idx just) acalignmentfit)
(/= (nth idx just) acalignmentaligned)
)
(vla-move tmp (vla-get-textalignmentpoint tmp) (nth idx txtpt))
(progn
(vla-move tmp (vla-get-insertionpoint tmp) (nth idx inspt))
(vla-put-alignment tmp acalignmentleft)
)
)
(vla-put-rotation tmp (nth idx rot))
(vla-put-scalefactor tmp (nth idx width))
(vla-put-stylename tmp (nth idx style))
(if (/= (nth idx attlyr) "0")
(vla-put-layer tmp (nth idx attlyr))
(vla-put-layer tmp layr)
)
(if (/= (nth idx attlyr) "0")
(vla-put-color tmp (nth idx attcol))
(vla-put-color tmp colr)
)
(cond
((and
(= (nth idx upsid) :vlax-true)
(= (nth idx bkwd) :vlax-false)
)
(vla-put-textgenerationflag tmp actextflagupsidedown)
)
((and
(= (nth idx upsid) :vlax-false)
(= (nth idx bkwd) :vlax-true)
)
(vla-put-textgenerationflag tmp actextflagbackward)
)
((and
(= (nth idx upsid) :vlax-true)
(= (nth idx bkwd) :vlax-true)
)
(vla-put-textgenerationflag tmp (+ actextflagbackward actextflagupsidedown))
)
)
(setq idx (1+ idx))
)
)
)
)
(undoend)
)
;;;;属性转文字函数结束
;;----------------------------------------------------------------------------
页:
[1]