bluebravo Posted August 1, 2017 Posted August 1, 2017 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! Quote
Aftertouch Posted August 1, 2017 Posted August 1, 2017 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) Quote
ReMark Posted August 1, 2017 Posted August 1, 2017 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. Quote
bluebravo Posted August 1, 2017 Author Posted August 1, 2017 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! Quote
ReMark Posted August 1, 2017 Posted August 1, 2017 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? Quote
Aftertouch Posted August 2, 2017 Posted August 2, 2017 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) Quote
ronjonp Posted August 2, 2017 Posted August 2, 2017 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) Quote
K Baden Posted August 8, 2017 Posted August 8, 2017 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? Quote
BIGAL Posted August 9, 2017 Posted August 9, 2017 (edited) 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 Quote
Movieangel81 Posted February 26, 2024 Posted February 26, 2024 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? Quote
BIGAL Posted February 26, 2024 Posted February 26, 2024 Just look at ssget "X" filter where the filter is the objects your looking for, example '((0 . "HATCH")) Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.