Maybe my title is unhelpful - my simple goal is to automate this process:
1. select all, burst, repeat until no more items to burst
2. select all, explode once (ideally blocks explode onto the blocks layer not "0")
3. repeat steps 1-2 until no more items to burst or explode.
4. repeat steps 1-3 for each layout
5. purge all (and overkill)
6. audit - fix errors
My cave-man attempts to smash the following lisps together and add step 4 to accomplish this has gone nowhere.
;; Author: Lee Mac, Copyright © 2010 - www.lee-mac.com ;;
;;----------------------------------------------------------------------;;
(defun c:myburst nil
(LM:startundo (LM:acdoc))
(LM:burst
(LM:ssget "\nSelect blocks to burst: "
(list "_:L"
(append '((0 . "INSERT"))
(
(lambda ( / def lst )
(while (setq def (tblnext "block" (null def)))
(if (= 4 (logand 4 (cdr (assoc 70 def))))
(setq lst (vl-list* "," (cdr (assoc 2 def)) lst))
)
)
(if lst (list '(-4 . "<NOT") (cons 2 (apply 'strcat (cdr lst))) '(-4 . "NOT>")))
)
)
(if (= 1 (getvar 'cvport))
(list (cons 410 (getvar 'ctab)))
'((410 . "Model"))
)
)
)
)
)
(LM:endundo (LM:acdoc))
(princ)
)
(defun LM:burst ( sel / cmd col ent idx lay lin lst obj qaf tmp )
(if (= 'pickset (type sel))
(repeat (setq idx (sslength sel))
(setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx))))
lay (vla-get-layer obj)
col (vla-get-color obj)
lin (vla-get-linetype obj)
)
(if (and (= "AcDbBlockReference" (vla-get-objectname obj))
(vlax-write-enabled-p obj)
(or (and (LM:usblock-p obj)
(not (vl-catch-all-error-p (setq lst (vl-catch-all-apply 'vlax-invoke (list obj 'explode)))))
)
(progn
(setq tmp (vla-copy obj)
ent (LM:entlast)
cmd (getvar 'cmdecho)
qaf (getvar 'qaflags)
)
(setvar 'cmdecho 0)
(setvar 'qaflags 0)
(vl-cmdf "_.explode" (vlax-vla-object->ename tmp))
(setvar 'qaflags qaf)
(setvar 'cmdecho cmd)
(while (setq ent (entnext ent))
(setq lst (cons (vlax-ename->vla-object ent) lst))
)
lst
)
)
)
(progn
(foreach att (vlax-invoke obj 'getattributes)
(if (vlax-write-enabled-p att)
(progn
(if (= "0" (vla-get-layer att))
(vla-put-layer att lay)
)
(if (= acbyblock (vla-get-color att))
(vla-put-color att col)
)
(if (= "byblock" (strcase (vla-get-linetype att) t))
(vla-put-linetype att lin)
)
)
)
(if (= :vlax-false (vla-get-invisible att))
( (if (and (vlax-property-available-p att 'mtextattribute) (= :vlax-true (vla-get-mtextattribute att)))
LM:burst:matt2mtext
LM:burst:att2text
)
(entget (vlax-vla-object->ename att))
)
)
)
(foreach new lst
(if (vlax-write-enabled-p new)
(progn
(if (= "0" (vla-get-layer new))
(vla-put-layer new lay)
)
(if (= acbyblock (vla-get-color new))
(vla-put-color new col)
)
(if (= "byblock" (strcase (vla-get-linetype new) t))
(vla-put-linetype new lin)
)
(if (= "AcDbAttributeDefinition" (vla-get-objectname new))
(progn
(if (and (= :vlax-true (vla-get-constant new)) (= :vlax-false (vla-get-invisible new)))
( (if (and (vlax-property-available-p new 'mtextattribute) (= :vlax-true (vla-get-mtextattribute new)))
LM:burst:matt2mtext
LM:burst:att2text
)
(entget (vlax-vla-object->ename new))
)
)
(vla-delete new)
)
)
)
)
)
(vla-delete obj)
)
)
)
)
(princ)
)
(defun LM:burst:removepairs ( itm lst )
(vl-remove-if '(lambda ( x ) (member (car x) itm)) lst)
)
(defun LM:burst:remove1stpairs ( itm lst )
(vl-remove-if '(lambda ( x ) (if (member (car x) itm) (progn (setq itm (vl-remove (car x) itm)) t))) lst)
)
(defun LM:burst:att2text ( enx )
(entmakex
(append '((0 . "TEXT"))
(LM:burst:removepairs '(000 002 003 070 074 100 280)
(subst (cons 73 (cdr (assoc 74 enx))) (assoc 74 enx) enx)
)
)
)
)
(defun LM:burst:matt2mtext ( enx )
(entmakex
(append '((0 . "MTEXT") (100 . "AcDbEntity") (100 . "AcDbMText"))
(LM:burst:remove1stpairs '(001 007 010 011 040 041 050 071 072 073 210)
(LM:burst:removepairs '(000 002 003 042 043 051 070 074 100 101 102 280 330 360) enx)
)
)
)
)
;; Uniformly Scaled Block - Lee Mac
;; Returns T if the supplied VLA Block Reference is uniformly scaled
;; obj - [vla] VLA Block Reference
(defun LM:usblock-p ( obj / s )
(if (vlax-property-available-p obj 'xeffectivescalefactor)
(setq s "effectivescalefactor")
(setq s "scalefactor")
)
(eval
(list 'defun 'LM:usblock-p '( obj )
(list 'and
(list 'equal
(list 'abs (list 'vlax-get-property 'obj (strcat "x" s)))
(list 'abs (list 'vlax-get-property 'obj (strcat "y" s)))
1e-8
)
(list 'equal
(list 'abs (list 'vlax-get-property 'obj (strcat "x" s)))
(list 'abs (list 'vlax-get-property 'obj (strcat "z" s)))
1e-8
)
)
)
)
(LM:usblock-p obj)
)
;; entlast - Lee Mac
;; A wrapper for the entlast function to return the last subentity in the database
(defun LM:entlast ( / ent tmp )
(setq ent (entlast))
(while (setq tmp (entnext ent)) (setq ent tmp))
ent
)
;; ssget - Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;; msg - [str] selection prompt
;; arg - [lst] list of ssget arguments
(defun LM:ssget ( msg arg / sel )
(princ msg)
(setvar 'nomutt 1)
(setq sel (vl-catch-all-apply 'ssget arg))
(setvar 'nomutt 0)
(if (not (vl-catch-all-error-p sel)) sel)
)
;; Start Undo - Lee Mac
;; Opens an Undo Group.
(defun LM:startundo ( doc )
(LM:endundo doc)
(vla-startundomark doc)
)
;; End Undo - Lee Mac
;; Closes an Undo Group.
(defun LM:endundo ( doc )
(while (= 8 (logand 8 (getvar 'undoctl)))
(vla-endundomark doc)
)
)
;; Active Document - Lee Mac
;; Returns the VLA Active Document Object
(defun LM:acdoc nil
(eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
(LM:acdoc)
)
;;----------------------------------------------------------------------;;
(vl-load-com)
(princ
(strcat
"\n:: BurstUpgraded.lsp | Version 1.4 | \\U+00A9 Lee Mac "
(menucmd "m=$(edtime,0,yyyy)")
" www.lee-mac.com ::"
"\n:: Type \"myburst\" to Invoke ::"
)
)
(princ)
;;----------------------------------------------------------------------;;
;; End of File ;;
;;----------------------------------------------------------------------;;
and
(defun c:nuke ( / ndx bss ess nss pss) ; *** Explodes all blocks in drawing.
(setq testx (getstring "This command explodes and purges all blocks from drawing. Hit Enter to continue or ESC to cancel"))
(setvar "cmdecho" 0)
(command "undo" "m")
(setq ndx 0
bss (ssget"x"'((2 . "*")))
)
(if bss (progn
(princ"\n---------------------------------------")
(repeat (sslength bss)
(setq pss (ssname bss ndx)
ndx (1+ ndx)
ess (entget pss)
nss (cdr (assoc 2 ess))
)
(princ "\nExploding block:\t ")(princ nss)
(command "_.explode" pss)
)
(princ"\n---------------------------------------")
(princ "\n")
(princ)
(command "purge" "bl" "*" "n")
(prompt"\nAll blocks exploded and purged!")
)
(alert"No blocks present in drawing.")
)
(setvar "cmdecho" 1)
(princ)
)
(defun c:blocklist ( / pss ndx ess nss)
(setq bss (ssget"x"'((2 . "*")))
ndx 0)
(if bss (progn
(textpage)
(princ"\n----------------------------")
(princ"\nPresent blocks in drawing: ")
(terpri)
(repeat (sslength bss)
(setq pss (ssname bss ndx)
ndx (1+ ndx)
ess (entget pss)
nss (cdr (assoc 2 ess))
)
(terpri)(princ nss)
)
(princ"\n----------------------------")
)
(alert"No blocks present in drawing.")
)
(princ)
)
(princ)
and
(defun C:CCAD ( / )
;; First we explode everything a few times...
(command ".explode" (ssget "_X" ) "")
(command ".explode" (ssget "_X" ) "")
(command ".explode" (ssget "_X" ) "")
(command ".explode" (ssget "_X" ) "")
;;define allobjects
(setq allobjects (ssget "_X" ))
;; Now OVERKILL
(command "_OVERKILL" allobjects "" "Yes" "Yes")
;; Now AUDIT
(command "_AUDIT" "Yes")
any help would be greatly appreciated!
