noochstyle Posted November 22, 2017 Posted November 22, 2017 (edited) Hello- This is part of a larger cleaning the drawing script, but for some reason it is failing to turn off the layers based on the filters. Any input would be great, I think it is a super simple mess up on my part....I can't find it though. It does call some other lisp routines within the program that are working great. (DEFUN C:XCLEAN () ; Defines Command Prompt Function Name (Prompt "\n*** Working, Please wait purge and auditting drawing......\n") ; Feedback to user (getvar "cmdecho") ; Get cmd echo variable status (setvar "cmdecho" 0) ; Turn off command line (getvar "Nomutt") ; Get Nomutt variable status (setvar "Nomutt" 1) ; Turn off command line ;; UNLOCK ALL ;; (command "-layer" "ON" "*" "thaw" "*" "u" "*" "color" "t" "255,0,255" "*" \e ) ; All layers on, unfrozen and unlock all layers, set color to magenta of all layers ;; DELETE ALL DIMENSIONS ;; (command "_.erase" (ssget "X" '((0 . "DIMENSION,LEADER"))) "") ;; SPECIALIZED BURST - SEE SCRIPTS BELOW ;; (C:DEMO) (C:DEMO) (C:DEMO) ;; DELETE ALL LAYOUTS ;; (vl-load-com) (setq layouts (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object)) ) ) (mapcar '(lambda (layout) (vla-delete (vla-item layouts layout)) ) (layoutlist) ) ;; DELETE ALL DIMENSIONS ;; (command "_.erase" (ssget "X" '((0 . "DIMENSION,LEADER"))) "") ;; SET ALL TO BY LAYER (command "LAYON" "LAYTHW" "SETBYLAYER" "ALL" "" "Y" "Y") ; SET ALL TO BY LAYER ;; PURGE AND AUDIT ;; (command "-purge" "All" "*" "N" \e) ; Purge all unused (command "tilemode" "1") ; Makes Model Space Current (command "zoom" "e") ; Zoom Extents (command "tilemode" "0") ; Makes Paper Space Current (command "-purge" "All" "*" "N" \e) ; Purge all unused (command "zoom" "e") ; Zoom Extents (command "_qsave") ; Save File (command "tilemode" "1") ; Makes Model Space Current (command "-purge" "All" "*" "N") ; Purge all unused (command "-UNITS" "4" "16" "1" "0" "90" "N" \e) ; Sets unit Architectual, 1/16" Precision, Decimal Degrees with no decimal spaces, Angle Zero at top of screen (command "-purge" "All" "*" "N" \e) ; Purge all unused (command "-purge" "All" "*" "N" \e) ; Purge all unused (command "-purge" "All" "*" "N" \e) ; Purge all unused (command "-purge" "All" "*" "N" \e) ; Purge all unused ;; CHANGE ALL HATCH TO COLOR 8 (command "_.chprop" (ssget "x" (list (cons 0 "HATCH"))) "" "Color" 8 "" ) [color="red"] ;; TURN OFF SPECIFIC LAYERS (command "-LAYER" "OFF" "*WALL-IDEN*" \e) (command "-LAYER" "OFF" "*DOOR-IDEN*" \e) (command "-LAYER" "OFF" "*DIMS*,*DEFPOINT*" \e)[/color] ;; SET TO COLOR 8 BY LAYER Name (command "-LAYER" "COLOR" 8 "*TREE*,*BUSH*,*PLANTS*" \e) (command "-LAYER" "COLOR" 8 "*LTS*,*LITE*,*LIGHT*" \e) (command "-LAYER" "COLOR" 8 "*FURN*,*DETL*" \e) (command "-LAYER" "COLOR" 8 "*CURB*,*PARK*" \e) (command "-LAYER" "COLOR" 8 "*PITCH*,*SLOPE*" \e) (command "-LAYER" "COLOR" 8 "*GRID*" \e) (command "-LAYER" "COLOR" 8 "*ANNO*,*IDEN*,*PATT*" \e) (command "_.erase" (ssget "X" '((0 . "DIMENSION,LEADER"))) "") (command "_qsave") ; Save File (setvar "Nomutt" 0) ; Turn on command line (Prompt "\n******************************************\n") ; Feedback to user (Prompt "\n******************************************\n") ; Feedback to user (Prompt "\n******************************************\n") ; Feedback to user (Prompt "\n******************************************\n") ; Feedback to user (Prompt "\n******************************************\n") ; Feedback to user (Prompt "\n******************************************\n") ; Feedback to user (Prompt "\n******* XCLEAN SCRIPT COMPLETE *********\n") ; Feedback to user (gc) ; Free ram resources ) Edited November 22, 2017 by noochstyle Identify Problem Area with Red Highlight Quote
ronjonp Posted November 22, 2017 Posted November 22, 2017 Try to use freeze? This work here for me: (command "-LAYER" "FREEZE" "*WALL-IDEN*" nil) Quote
noochstyle Posted November 22, 2017 Author Posted November 22, 2017 That works, just curious that the OFF doesn't but the "Freeze" does.... There should be no difference between nil and \e in this situation correct? And thank you!!! Should have opened with that part. Quote
ronjonp Posted November 22, 2017 Posted November 22, 2017 (edited) Try to use freeze? This work here for me: (command "-LAYER" "FREEZE" "*WALL-IDEN*" nil) I've never seen \e used in a command call so don't know if they are the same. Most of this layer stuff could be automated without any command. Here is a quick example to change layer colors: (vl-load-com) (defun layer2color (pattern color / n) (vlax-for l (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) (if (wcmatch (setq n (strcase (vla-get-name l))) (strcase pattern)) (vla-put-color l color) ) (princ) ) ) (layer2color "*TREE*,*BUSH*,*PLANTS*,*LTS*,*LITE*,*LIGHT*,*FURN*,*DETL*,*CURB*,*PARK*,*PITCH*,*SLOPE*,*ANNO*,*IDEN*,*PATT*" 8 ) (defun layer2colorvanilla (pattern color / e l n) (while (setq l (tblnext "layer" (null l))) (and (setq n (cdr (assoc 2 l))) (wcmatch (strcase n) (strcase pattern)) (setq e (tblobjname "layer" n)) (setq e (entmod (append (entget e) (list (cons 62 color))))) ) ) (princ) ) (layer2colorvanilla "*TREE*,*BUSH*,*PLANTS*,*LTS*,*LITE*,*LIGHT*,*FURN*,*DETL*,*CURB*,*PARK*,*PITCH*,*SLOPE*,*ANNO*,*IDEN*,*PATT*" 8 ) And you're welcome Edited November 22, 2017 by ronjonp Quote
noochstyle Posted November 22, 2017 Author Posted November 22, 2017 (defun layer2colorvanilla (pattern color / e l n) ;; Make mask layer colors 255,255,255 (while (setq l (tblnext "layer" (null l))) (and (setq n (cdr (assoc 2 l))) (wcmatch (strcase n) (strcase pattern)) (setq e (tblobjname "layer" n)) (setq e (entmod (append (entget e) (list (cons 62 color))))) ) ) (princ) ) (layer2colorvanilla "*TREE*,*BUSH*,*PLANTS*,*LTS*,*LITE*,*LIGHT*,*FURN*,*DETL*,*CURB*,*PARK*,*PITCH*,*SLOPE*,*ANNO*,*IDEN*,*PATT*" 8 ) This works great, and probably much faster to make the change than passing the commands through. I don't really understand the masking part. I used the definition the same way for the first part but took at the "vanilla" part (like the name choice though, ha-ha). I just pass it using this: (vl-load-com) (defun layer2color (pattern color / n) (vlax-for l (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) (if (wcmatch (setq n (strcase (vla-get-name l))) pattern) (vla-put-color l color) ) (princ) ) ) (layer2color "*TREE*,*BUSH*,*PLANTS*,*LTS*,*LITE*,*LIGHT*,*FURN*,*DETL*,*CURB*,*PARK*,*PITCH*,*SLOPE*,*ANNO*,*IDEN*,*PATT*,*GENM*" 8 ) Quote
ronjonp Posted November 22, 2017 Posted November 22, 2017 Here's some more to mull over The mask note was something I had for different code .. you can disregard it. (defun c:layerschtuff (/ doc n s) ;; To modelspace (setvar 'tilemode 1) (vlax-for l (vla-get-layers (setq doc (vla-get-activedocument (vlax-get-acad-object)))) ;; Unlock layers (vl-catch-all-apply 'vla-put-lock (list l :vlax-false)) ;; Color magenta (vla-put-color l 6) (setq n (strcase (vla-get-name l))) ;; Color 8 (if (wcmatch n "*TREE*,*BUSH*,*PLANTS*,*LTS*,*LITE*,*LIGHT*,*FURN*,*DETL*,*CURB*,*PARK*,*PITCH*,*SLOPE*,*ANNO*,*IDEN*,*PATT*" ) (vla-put-color l ) ;; Freeze layers (if (wcmatch n "*WALL-IDEN*,*DOOR-IDEN*,*DIMS*,*DEFPOINT*") (vl-catch-all-apply 'vla-put-freeze (list l :vlax-true)) ) ) ;; Delete dims and leaders (and (setq s (ssget "X" '((0 . "DIMENSION,LEADER")))) (mapcar 'entdel (mapcar 'cadr (ssnamex s)))) ;; Delete layouts (vlax-for l (vla-get-layouts doc) (vl-catch-all-apply 'vla-delete (list l))) (princ) ) (c:layerschtuff) Quote
noochstyle Posted November 22, 2017 Author Posted November 22, 2017 Is it that much more efficient to use what I VBA/Activex in lieu of passing the commands? does the mapcar make the deleting dimensions recursive through all entities or will the command need to be run multiple times to eliminate those dimensions within burst entities after they are burst? You are going to send me down the coding rabbit whole, ha-ha. Quote
ronjonp Posted November 22, 2017 Posted November 22, 2017 What I like about NOT using command calls is the consistency of code working between version of AutoCAD .. and yes generally it is much faster. As far as the deleting dims after exploding, you'd need to repeat x times while bursting .. something like so. ;; Repeat 10 times exploding block and deleting dims (repeat 10 (and (setq s (ssget "_X" '((0 . "insert") (410 . "Model")))) (command "_.explode" s)) (and (setq s (ssget "_X" '((0 . "DIMENSION,LEADER") (410 . "Model")))) (mapcar 'entdel (mapcar 'cadr (ssnamex s))) ) ) ... You are going to send me down the coding rabbit whole, ha-ha. I hope so .. once you start understanding the code it gets quite addictive! Quote
noochstyle Posted November 22, 2017 Author Posted November 22, 2017 That is cool the repeat command! Definitely didn't know about that one. Well you re-wrote a nice chunk of my code into a better format....much appreciated. I think I might use the repeat as well for my purge command. I am thinking to just run the dim delete routine right before the last purge. I was just trying to speed things up by deleting as much of the unneeded stuff as possible. Quote
noochstyle Posted November 22, 2017 Author Posted November 22, 2017 Ok I am sold. (vla-purgeall (vla-get-activeDocument (vlax-get-acad-object))) SILENT AND FASTER THAN: (command "-purge" "All" "*" "N" nil) Quote
noochstyle Posted November 22, 2017 Author Posted November 22, 2017 RONJONP - Thanks for your help, code runs 100x cleaner and much faster. Command line is clean an uninterrupted. Love the change. I might try and change the following lines, but for now I am going leave them as is [i am an electrical engineer by trade not a programmer and should get to my daily tasks =) ] Here you go if you want to see the almost finished project. Going to start re-organizing my other scripts the same way. Appreciate the lesson! (DEFUN C:XCLEAN () ; Defines Command Prompt Function Name (Prompt "\n*** Working, Please wait working on the drawing......\n") ; Feedback to user ;; TURN OFF COMMAND LINE (getvar "cmdecho") ; Get cmd echo variable status (setvar "cmdecho" 0) ; Turn off command line (getvar "Nomutt") ; Get Nomutt variable status (setvar "Nomutt" 1) ; Turn off command line ;; UNLOCK ALL ;; (command "-layer" "ON" "*" "thaw" "*" "u" "*" "color" "t" "255,0,255" "*" NIL ) ; All layers on, unfrozen and unlock all layers, set color to magenta of all layers ;; DELETE ALL DIMENSIONS ;; (and (setq s (ssget "X" '((0 . "DIMENSION,LEADER")))) (mapcar 'entdel (mapcar 'cadr (ssnamex s)))) ;; SPECIALIZED BURST - SEE SCRIPTS BELOW ;; (repeat 4 (C:DEMO) ) ;; To modelspace (setvar 'tilemode 1) (vlax-for l (vla-get-layers (setq doc (vla-get-activedocument (vlax-get-acad-object)))) ;; Unlock layers (vl-catch-all-apply 'vla-put-lock (list l :vlax-false)) ;; Color magenta (vla-put-color l 6) (setq n (strcase (vla-get-name l))) ;; LAYERS TO CHANGE TO COLOR 8 BY FILTER (if (wcmatch n "*TREE*,*BUSH*,*PLANTS*,*LTS*,*LITE*,*LIGHT*,*FURN*,*DETL*,*CURB*,*PARK*,*PITCH*,*SLOPE*,*ANNO*,*IDEN*,*PATT*,*GRID*" ) (vla-put-color l ) ;; LAYERS TO FREEZE BY FILTER (if (wcmatch n "*WALL-IDEN*,*DOOR-IDEN*,*DIM*,*DEFPOINT*") (vl-catch-all-apply 'vla-put-freeze (list l :vlax-true)) ) ) ;; Delete dims and leaders (and (setq s (ssget "X" '((0 . "DIMENSION,LEADER")))) (mapcar 'entdel (mapcar 'cadr (ssnamex s)))) ;; Delete layouts (vlax-for l (vla-get-layouts doc) (vl-catch-all-apply 'vla-delete (list l))) ;; SET ALL TO BY LAYER (command "SETBYLAYER" "ALL" "" "Y" "Y") ; SET ALL TO BY LAYER ;; PURGE AND AUDIT ;; (setvar 'tilemode 1) ; Makes Model Space Current (command "zoom" "e") ; Zoom Extents (setvar 'tilemode 0) ; Makes Paper Space Current (command "zoom" "e") ; Zoom Extents (command "_qsave") ; Save File (setvar 'tilemode 1) ; Makes Model Space Current (command "-UNITS" "4" "16" "1" "0" "90" "N" \e) ; Sets unit Architectual, 1/16" Precision, Decimal Degrees with no decimal spaces, Angle Zero at top of screen ;; DELETE ALL DIMENSIONS ;; (and (setq s (ssget "X" '((0 . "DIMENSION,LEADER")))) (mapcar 'entdel (mapcar 'cadr (ssnamex s)))) ;; PURGE 2X (repeat 2 ; Purge 5x (vla-purgeall (vla-get-activeDocument (vlax-get-acad-object))) ; Purge all unused ) ;; CHANGE ALL HATCH TO COLOR 8 (command "_.chprop" (ssget "x" (list (cons 0 "HATCH"))) "" "Color" 8 "" ) ;; DELETE ALL DIMENSIONS ;; (and (setq s (ssget "X" '((0 . "DIMENSION,LEADER")))) (mapcar 'entdel (mapcar 'cadr (ssnamex s)))) ;; PURGE 3X (repeat 3 ; Purge 5x (vla-purgeall (vla-get-activeDocument (vlax-get-acad-object))) ; Purge all unused ) ;; SAVE DRAWING (command "_qsave") ; Save File ;; TURN ON COMMAND LINE (setvar "Nomutt" 0) ; Turn ON command line (setvar "cmdecho" 1) ; Turn ON command line (Prompt "\n******************************************\n") ; Feedback to user (Prompt "\n******* XCLEAN SCRIPT COMPLETE *********\n") ; Feedback to user (gc) ; Free ram resources ) Only a few commands left to convert (thawing all layers - which I will attack tonight): (command "zoom" "e") ; Zoom Extents (command "_qsave") ; Save File (command "-UNITS" "4" "16" "1" "0" "90" "N" \e) ; Sets unit Architectual, 1/16" Precision, Decimal Degrees with no decimal spaces, Angle Zero at top of screen (Prompt "\n******* XCLEAN SCRIPT COMPLETE *********\n") ; Feedback to user A challenger for another day. Made leaps and bounds with your input, thanks again! John Quote
ronjonp Posted November 23, 2017 Posted November 23, 2017 Here's some more input .. I'm off for the holiday enjoy the puzzle! (defun c:xclean (/ doc n s) ;<- localize variables! (prompt "\n*** Working, Please wait working on the drawing......\n") ; Feedback to user ;; TURN OFF COMMAND LINE ;;(getvar "cmdecho") ; Get cmd echo variable status (setvar "cmdecho" 0) ; Turn off command line ;;(getvar "Nomutt") ; Get Nomutt variable status (setvar "Nomutt" 1) ; Turn off command line ;; UNLOCK ALL ;; ;;(command "-layer" "ON" "*" "thaw" "*" "u" "*" "color" "t" "255,0,255" "*" nil) ; All layers on, unfrozen and unlock all layers, set color to magenta of all layers ;; DELETE ALL DIMENSIONS ;; (and (setq s (ssget "X" '((0 . "DIMENSION,LEADER")))) (mapcar 'entdel (mapcar 'cadr (ssnamex s)))) ;; SPECIALIZED BURST - SEE SCRIPTS BELOW ;; (repeat 4 (c:demo)) ;; To modelspace (setvar 'tilemode 1) (vlax-for l (vla-get-layers (setq doc (vla-get-activedocument (vlax-get-acad-object)))) ;; Unlock layer (vl-catch-all-apply 'vla-put-lock (list l :vlax-false)) ;; Turn on layer (vl-catch-all-apply 'vla-put-layeron (list l :vlax-true)) ;; Thaw layer (vl-catch-all-apply 'vla-put-freeze (list l :vlax-false)) ;; Color magenta (vla-put-color l 6) (setq n (strcase (vla-get-name l))) ;; LAYERS TO CHANGE TO COLOR 8 BY FILTER (if (wcmatch n "*TREE*,*BUSH*,*PLANTS*,*LTS*,*LITE*,*LIGHT*,*FURN*,*DETL*,*CURB*,*PARK*,*PITCH*,*SLOPE*,*ANNO*,*IDEN*,*PATT*,*GRID*" ) (vla-put-color l ) ;; LAYERS TO FREEZE BY FILTER (if (wcmatch n "*WALL-IDEN*,*DOOR-IDEN*,*DIM*,*DEFPOINT*") (vl-catch-all-apply 'vla-put-freeze (list l :vlax-true)) ) ) ;; Delete dims and leaders (and (setq s (ssget "X" '((0 . "DIMENSION,LEADER")))) (mapcar 'entdel (mapcar 'cadr (ssnamex s)))) ;; Delete layouts (vlax-for l (vla-get-layouts doc) (vl-catch-all-apply 'vla-delete (list l))) ;; SET ALL TO BY LAYER (command "SETBYLAYER" "ALL" "" "Y" "Y") ; SET ALL TO BY LAYER ;; PURGE AND AUDIT ;; (setvar 'tilemode 1) ; Makes Model Space Current ;; RJP - replaced with vla .. although not sure of speed performance (command "zoom" "e") ; Zoom Extents (vla-zoomextents (vlax-get-acad-object)) (setvar 'tilemode 0) ; Makes Paper Space Current ;; RJP - replaced with vla .. although not sure of speed performance (command "zoom" "e") ; Zoom Extents (vla-zoomextents (vlax-get-acad-object)) ;; RJP - replaced with vla .. although not sure of speed performance (command "_qsave") ; Save File (vla-save doc) (setvar 'tilemode 1) ; Makes Model Space Current ;; RJP - (setvar 'lunits 4) = -units 4 .. I'm sure there are variables for the other settings but I've had too much beer tonight (setvar 'lunits 4) (command "-UNITS" "4" "16" "1" "0" "90" "N" nil) ; Sets unit Architectual, 1/16" Precision, Decimal Degrees with no decimal spaces, Angle Zero at top of screen ;; DELETE ALL DIMENSIONS ;; (and (setq s (ssget "X" '((0 . "DIMENSION,LEADER")))) (mapcar 'entdel (mapcar 'cadr (ssnamex s)))) ;; RJP - Vla-purgeall may not have the same effect as the command call ( test it! ) ;; PURGE 2X (repeat 2 (vla-purgeall doc)) ;; CHANGE ALL HATCH TO COLOR 8 ;; RJP - check that you have hatch before calling the command .. converted to entmod for color (and (setq s (ssget "x" (list (cons 0 "HATCH")))) (mapcar '(lambda (x) (entmod (append (entget x) '((62 . )))) (mapcar 'cadr (ssnamex s))) ) ;; DELETE ALL DIMENSIONS ;; (and (setq s (ssget "X" '((0 . "DIMENSION,LEADER")))) (mapcar 'entdel (mapcar 'cadr (ssnamex s)))) ;; RJP - Vla-purgeall may not have the same effect as the command call ( test it! ) maybe just purge all at the end? USe 'doc' defined above (repeat 3 (vla-purgeall doc)) ;; RJP - replaced with vla (vla-save doc) ; Save File ;; TURN ON COMMAND LINE (setvar "Nomutt" 0) ; Turn ON command line (setvar "cmdecho" 1) ; Turn ON command line (prompt "\n******************************************\n") ; Feedback to user (prompt "\n******* XCLEAN SCRIPT COMPLETE *********\n") ; Feedback to user (gc) ; Free ram resources ) 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.