Jump to content
bluebravo

LISP | Clean Drawing | Explode and Purge

Recommended Posts

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!

Share this post


Link to post
Share on other sites
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)

Share this post


Link to post
Share on other sites
ronjonp
THIS should get you the layer 0 part.

Share this post


Link to post
Share on other sites
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.

Share this post


Link to post
Share on other sites
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!

Share this post


Link to post
Share on other sites
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?

Share this post


Link to post
Share on other sites
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)

Share this post


Link to post
Share on other sites
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)

Share this post


Link to post
Share on other sites
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?

Share this post


Link to post
Share on other sites
ronjonp
(setq e "ICE BRIDGES,ICEBRIDGEDYN")

Share this post


Link to post
Share on other sites
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 by BIGAL

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×