综合炸开清理【程序出错】

尘缘一生 · 发表于 2018-6-28 12:59:02

本帖最后由尘缘一生于 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)
)
;;;;属性转文字函数结束
;;----------------------------------------------------------------------------

;;---炸开清理全图------------------------------------------------------------------------- 
 
(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) 
) 
;;;;属性转文字函数结束 
;;----------------------------------------------------------------------------

户籍科 · 发表于 2018-7-5 13:06:10

提示: 作者被禁止或删除内容自动屏蔽

账号		自动登录	找回密码
密码			注册

[提问] 综合炸开清理【程序出错】

本帖子中包含更多资源

浏览过的版块

户籍科户籍科当前离线积分 8683 明经币个注册时间 2018-7-5 在线时间小时威望金钱个贡献激情	发表于 2018-7-5 13:06:10 \| 显示全部楼层提示: 作者被禁止或删除内容自动屏蔽

	回复使用道具举报显身卡