LISP | Clean Drawing | Explode

bluebravo · 发表于 2022-7-5 16:08:23

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 · 发表于 2022-7-5 16:17:15

Something like this?

copy

(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 · 发表于 2022-7-5 16:23:06

THIS should get you the layer 0 part.

ReMark · 发表于 2022-7-5 16:29:17

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 · 发表于 2022-7-5 16:34:07

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 · 发表于 2022-7-5 16:43:17

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 · 发表于 2022-7-5 16:47:18

Made a few changes, added in ReMarks suggestions.

copy

(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 · 发表于 2022-7-5 16:53:19

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

copy

  (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 · 发表于 2022-7-5 16:58:22

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"?

copy

(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 · 发表于 2022-7-5 17:08:01

copy

(setq e "ICE BRIDGES,ICEBRIDGEDYN")

[编程交流] LISP | Clean Drawing | Explode

发表回复

精选推荐