[综合讨论] Isolate a layer to work on?

;;; ------------------------------------------------------------------------;;;    LayerToggle.lsp v1.0;;;;;;    Copyright© 04.29.09;;;    Alan J. Thompson (alanjt);;;;;;    Permission to use, copy, modify, and distribute this software;;;    for any purpose and without fee is hereby granted, provided;;;    that the above copyright notice appears in all copies and;;;    that both that copyright notice and the limited warranty and;;;    restricted rights notice below appear in all supporting;;;    documentation.;;;;;;    The following program(s) are provided "as is" and with all faults.;;;    Alan J. Thompson DOES NOT warrant that the operation of the program(s);;;    will be uninterrupted and/or error free.;;;;;;    Allows user to isolate layers of selected object(s) and current layer.;;;    On second execution of program, previously turned off layers are turned on.;;;    Layer list, for reset, is stored as global variable '*LayerToggleLayers*'.;;;;;;    Thanks to Walt Bedinger, I really liked his idea and wanted to write my own.;;;;;;    Revision History:;;;;;; ------------------------------------------------------------------------(defun c:, (/) (c:LayerToggle))(defun c:LayerToggle (/              *error*        AT:Undo                     AT:SS->List    AT:LayerList   AT:LayerListOff                     #SSList        #SSLayers                    );;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; SUBROUTINES ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; error handler (defun *error* (msg)   (AT:Undo "V" "E")   (if     (not       (member         msg         '("console break" "Function cancelled" "quit / exit abort")       ) ;_ member     ) ;_ not      (princ (strcat "\nError: " msg))   ) ;_ if ) ;_ defun;;; ------------------------------------------------------------------------;;;    AT:Undo.lsp v1.0;;;    (SubRoutine);;;;;;    Copyright© 03.23.09;;;    Alan J. Thompson (alanjt);;;;;;    Permission to use, copy, modify, and distribute this software;;;    for any purpose and without fee is hereby granted, provided;;;    that the above copyright notice appears in all copies and;;;    that both that copyright notice and the limited warranty and;;;    restricted rights notice below appear in all supporting;;;    documentation.;;;;;;    Undo "BEGIN" and "END" options, with choice of using "COMMAND";;;    or "VLA". User inputs coding choice (Command or VLA) and the;;;    choice to issue an 'undo begin' or 'undo end'.;;;;;;    Arguments:;;;    #CommandVLA - Option to use command or VLA for undo marking.;;;              ("V" for VLA, "C" for Command);;;    #BeginEnd - Option to issue an 'Undo Begin' or 'Undo End'.;;;            ("B" for Begin, "E" for End).;;;;;;    Examples:;;;    (defun c:TEST ( / p1 p2 );;;          (AT:Undo "C" "B");;;          (and;;;            (setq p1 (getpoint "\nPoint 1: "));;;            (setq p2 (getpoint p1 "\nPoint 2: "));;;            (command "_.line" p1 p2 "";;;                     "_.circle" p1 2;;;                     "_.circle" p2 2));;;            (AT:Undo "C" "E"));;;;;;    Revision History:;;;;;; ------------------------------------------------------------------------ (defun AT:Undo (#CommandVLA #BeginEnd / #OldCmdecho)   (if     (and       (member (strcase #CommandVLA) (list "C" "V"))       (member (strcase #BeginEnd) (list "B" "E"))     ) ;_ and      (cond        ;; COMMAND Undo Options        ((eq "C" (strcase #CommandVLA))         (setq #OldCmdecho (getvar "cmdecho"))         (setvar "cmdecho" 0)         (cond           ;; Undo Begin           ((eq "B" (strcase #BeginEnd)) (command "_.undo" "_be"))           ;; Undo End           ((eq "E" (strcase #BeginEnd)) (command "_.undo" "_e"))         ) ;_ cond         (setvar "cmdecho" #OldCmdecho)        )        ;; VLA Undo Options        ((eq "V" (strcase #CommandVLA))         (cond           ;; Undo Begin           ((eq "B" (strcase #BeginEnd))            (vla-StartUndoMark              (vla-get-ActiveDocument                (vlax-get-Acad-Object)              ) ;_ vla-get-ActiveDocument            ) ;_ vla-StartUndoMark           )           ;; Undo End           ((eq "E" (strcase #BeginEnd))            (vla-EndUndoMark              (vla-get-ActiveDocument                (vlax-get-Acad-Object)              ) ;_ vla-get-ActiveDocument            ) ;_ vla-EndUndoMark           )         ) ;_ cond        )      ) ;_ cond   ) ;_ if ) ;_ defun;;; Convert selection set to list of ename or vla objects;;; #Selection - SSGET selection set;;; #VLAList - T for vla objects, nil for ename;;; Alan J. Thompson, 04.20.09(defun AT:SS->List (#Selection #VlaList / #List) (and #Selection      (setq #List (vl-remove-if                    'listp                    (mapcar 'cadr (ssnamex #Selection))                  ) ;_ vl-remove-if      ) ;_ setq      (if #VlaList        (setq #List (mapcar 'vlax-ename->vla-object #List))      ) ;_ if ) ;_ and #List) ;_ defun;;; Create list of layer objects in drawing;;; Alan J. Thompson, 04.16.09 (defun AT:LayerList (/ #Layers #List)   (setq #Layers (vla-get-Layers                   (vla-get-activedocument                     (vlax-get-acad-object)                   ) ;_ vla-get-activedocument                 ) ;_ vla-get-Layers   ) ;_ setq   (vlax-for x #Layers     (setq #List (cons x #List))   ) ;_ vlax-for   (vlax-release-object #Layers)   #List ) ;_ defun;;; Create list of layer objects in drawing (turned off);;; Alan J. Thompson, 04.28.09 (defun AT:LayerListOff (/ #Layers #List)   (setq #Layers (vla-get-Layers                   (vla-get-activedocument                     (vlax-get-acad-object)                   ) ;_ vla-get-activedocument                 ) ;_ vla-get-Layers   ) ;_ setq   (vlax-for x #Layers     (if (eq (vla-get-LayerOn x) :vlax-false)       (setq #List (cons x #List))     ) ;_ if   ) ;_ vlax-for   (vlax-release-object #Layers)   #List ) ;_ defun;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; MAIN ROUTINE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (vl-load-com) (AT:Undo "V" "B") (cond   ;; global variable *LayerToggleLayers* not nil   (*LayerToggleLayers*    (mapcar      '(lambda (x)         (if (not (member x *LayerToggleLayers*))           (vla-put-layeron x :vlax-true)         ) ;_ if       ) ;_ lambda      (AT:LayerList)    ) ;_ mapcar    (setq *LayerToggleLayers* nil)    (prompt "\nLayers have been reset!")   )   ;; global variable *LayerToggleLayers* nil   ((not *LayerToggleLayers*)    (or (ssget "_I")        (prompt (strcat "\nSelect objects on layers to isolate : "                ) ;_ strcat        ) ;_ prompt    ) ;_ or    (cond      ((or (setq #SSList (AT:SS->List (ssget) T))           (setq             #SSLayers (list (vlax-ename->vla-object                               (tblobjname "layer" (getvar "clayer"))                             ) ;_ vlax-ename->vla-object                       ) ;_ list           ) ;_ setq       ) ;_ or       ;;set global variable of off layers       (or (foreach x (AT:LayerList)             (if (eq (vla-get-layeron x) :vlax-false)               (setq *LayerToggleLayers* (cons x *LayerToggleLayers*))             ) ;_ if             *LayerToggleLayers*           ) ;_ foreach           (setq *LayerToggleLayers* (list ""))       ) ;_ or       (cond         ;; have selection of objects, time to rip out layer list & add current layer (if not member)         ((not #SSLayers)          (mapcar            '(lambda (x)               (if (not (member                          (vlax-ename->vla-object                            (tblobjname                              "layer"                              (vla-get-layer x)                            ) ;_ tblobjname                          ) ;_ vlax-ename->vla-object                          #SSLayers                        ) ;_ member                   ) ;_ not                 (setq #SSLayers (cons (vlax-ename->vla-object                                         (tblobjname                                           "layer"                                           (vla-get-layer x)                                         ) ;_ tblobjname                                       ) ;_ vlax-ename->vla-object                                       #SSLayers                                 ) ;_ cons                 ) ;_ setq               ) ;_ if             ) ;_ lambda            #SSList          ) ;_ mapcar          ;; if current layer is not member of list, add to it          (if (not (member (getvar "clayer")                           (mapcar 'vla-get-name #SSLayers)                   ) ;_ member              ) ;_ not            (setq              #SSLayers               (cons (vlax-ename->vla-object                       (tblobjname "layer" (getvar "clayer"))                     ) ;_ vlax-ename->vla-object                     #SSLayers               ) ;_ cons            ) ;_ setq          ) ;_ if         )       ) ;_ cond       ;; have layer list from selection, time to isolate list       (mapcar         '(lambda (x)            (if (not (member x #SSLayers))              (vla-put-layeron x :vlax-false)            ) ;_ if            (vlax-release-object x)          ) ;_ lambda         (AT:LayerList)       ) ;_ mapcar       ;; isolation complete, print results to commandline       (cond         ;; only current layer isolated         ((eq (length #SSLayers) 1)          (prompt (strcat "\nThe current layer ""                          (getvar "clayer")                          "" has been isolated!"                  ) ;_ strcat          ) ;_ prompt         )         ;; more than just current layer isolated         (T          (print (mapcar 'vla-get-name #SSLayers))          (prompt (strcat "\n "                          (rtos (length #SSLayers) 2 0)                          " layers have been isolated!"                  ) ;_ strcat          ) ;_ prompt         )       ) ;_ cond      )    ) ;_ cond   ) ) ;_ cond (AT:Undo "V" "E") (princ)) ;_ defun