LISP | Clean Drawing | Explode and Purge

[bluebravo]

Explanation: To clean up consultant drawings I explode everything multiple times, move all objects to 0 layer, change all properties to By Layer (or equivalent), and purge the file. Then I Ctrl+Shift+C to select base point and in my file Ctrl-Shift+V to create a clean block that serves as the base for our drawings.

 

Goal: LISP that does all the cleaning! Including:

 

1. Explode everything multiple times

2. Select everything in file and

layer --> 0

color -->By Layer

linetype --> By Layer

lineweight --> By Layer

3. Purge everything (to be left with only 0 layer)

 

I've found bits and pieces in different posts, but I am hoping to get some more comprehensive help.

 

 

Thank you for your time, in advance!

[Aftertouch]

Something like this?

 

(defun C:BIGBANG ( / )

;; First we busrt everything a few times...
(setq timesexplode 10) ;Change number to suit your needs
(repeat timesexplode
(setvar "qaflags" 1)
(command ".explode" (ssget "_X" ) "")
(setvar "qaflags" 0)
)

;define allobjects
(setq allobjects (ssget "_X" ))

;; Now set everything by layer...
(command "_SetByLayer" allobjects "" "Yes" "Yes")

;; Set everything to layer 0
(command "_CHANGE" allobjects "" "Properties" "Layer" "0" "")

;; Set current layer 0
(setvar "CLAYER" "0")

;; Purge the drawing
(command "-Purge" "All" "*" "No")

(princ)
)

(princ)

[ronjonp]

THIS should get you the layer 0 part.

[ReMark]

Would running the Overkill command be necessary with these drawings?

 

You should purge Regapps first then do a Purge > All.

 

I would also suggest running the Audit command and answer Yes to fixing any errors that are found in the database.

[bluebravo]

Aftertouch -- Thanks, your lisp works great!

 

ReMark -- I do not necessarily need overkill; the goal is just to rid the cad of any consultant blocks, layers, styles, etc. And I will look into adding the audit command, thanks for the suggestion!

[ReMark]

Overkill rids drawings of duplicate and overlapping lines, arcs and polylines. Have you ever tested one of the drawings to see if such entities exist in the drawings you are receiving?

[Aftertouch]

Made a few changes, added in ReMarks suggestions.

 

(defun C:BIGBANG ( / )
;; Set undo begin and silence program
(setvar "cmdecho" 0)
(command "UNDO" "BEGIN")

;; First we busrt everything a few times
(setq timesexplode 10) ;Change number to suit your needs
(repeat timesexplode
(setvar "QAFLAGS" 1)
(command ".explode" (ssget "_X" ) "")
(setvar "QAFLAGS" 0)
)

;define allobjects
(setq allobjects (ssget "_X" ))

;; Now set everything by layer...
(command "_SETBYLAYER" allobjects "" "Yes" "Yes")

;; Set everything to layer 0
(command "_CHANGE" allobjects "" "Properties" "Layer" "0" "")

;; Set current layer 0
(setvar "CLAYER" "0")

;; Audit the drawing
(command "_AUDIT" "Yes")

;; Purge the drawing
(command "_PURGE" "Regapps" "*" "No")
(command "_PURGE" "All" "*" "No")

;; Remove duplicates for better performance
(command "-OVERKILL" allobjects "" "Ignore" "None" "Done")

;; Tell use the program is finished
(princ "\n\nJobs done.")

;; Set undo end and wake up program
(command "UNDO" "END")
(setvar "cmdecho" 1)
(princ)
)

(princ)

[ronjonp]

You also might add in something like this to unlock all layers and make sure the blocks can actually be exploded.

  (setq ad (vla-get-activedocument (vlax-get-acad-object)))
 (vlax-for b (vla-get-blocks ad) (vla-put-explodable b :vlax-true))
 (vlax-for l (vla-get-layers ad) (vla-put-lock b :vlax-false))

 

Also don't forget to localize your variables: ( / ALLOBJECTS TIMESEXPLODE)

[K Baden]

I can't really find a thread that's exactly what i'm after. I have a code that works beautifully for finding a block by its name, then using the "BURST" command on it. I would like to add more block names to it "ICEBRIDGEDYN" is the one i want to add now. I'm very new to coding. Can anyone show me the code that would look for "ICE BRIDGES" and "ICEBRIDGEDYN"?

 

(vl-load-com)

(defun c:BIB ( / e ss objs blk) ; by name
 (setq e "ICE BRIDGES" ; (getstring T "ICE BRIDGES")
       objs (ssadd))
 (if (setq ss (ssget "_X" '((0 . "INSERT"))))
   (progn
     (repeat (setq i (sslength ss))
       (setq name (strcase (vla-get-effectivename (vlax-ename->vla-object (setq blk (ssname ss (setq i (1- i))))))))
       (if (wcmatch name (strcase e))
         (ssadd blk objs)))
   (if (> (sslength objs) 0)
     (progn
(sssetfirst nil objs)
(c:burst)))))
 (princ)
)

 

can anyone help me out?

[ronjonp]

(setq e "ICE BRIDGES,ICEBRIDGEDYN")

[BIGAL]

If there are the only two layers starting with ICE. This saves checking block names

 

(if (setq ss (ssget "_X" (list (cons 0  "INSERT")(cons 2 "ICE*"))))

Edited August 9, 2017 by BIGAL

[Movieangel81]

I know this is an old thread but I find Aftertouch's lisp to be almost exactly what I need. Is there a way to also have it delete all dimensions and all hatches? Maybe all attributes?

[BIGAL]

Just look at ssget "X" filter where the filter is the objects your looking for, example  '((0 . "HATCH"))