[编程交流] 下线过滤器故障-can和#03

(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
)

        (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