[编程交流] 表格图层选择

With CmbBox
   .AddItem "qty 1", 0
   .AddItem "qty 2", 1
   .AddItem "qty 3", 2
   .AddItem "qty 4", 3
   .ListIndex = 0
End With

(defun c:patlay(/ oldPat cFlag lLst Ans actDoc aName oldLay)
(vl-load-com)
(defun StoreLayerStates()
(setq patlay:layerstate nil)
(vlax-for l(vla-get-Layers actDoc)
(setq patlay:layerstate
    (append patlay:layerstate
    (list
    (list l
       (vla-get-LayerOn l)
        (vla-get-Lock l)
        (vla-get-Freeze l)
        ); end list
    ); end list
    ); end apend
    ); end setq
); end vlax-for
(princ)
); end of StoreLayerStates
(if(not laypat:pat)(setq laypat:pat ""))
(setq oldPat laypat:pat)
(while(not cFlag)
(setq laypat:pat(getstring T
        (strcat "\nLayer name pattern or [Help/Quit] <"
            laypat:pat ">: ")))
(cond
((member laypat:pat '("H" "h" "_H" "_h" "Help" "HELP" "help"))
(princ "\n <<< PATTERNS AVAILABLE >>> \n")
(princ "\n # - Matches any single numeric digit.")
(princ "\n @ - Matches any single alphabetic character.")
(princ "\n . - Matches any single nonalphanumeric character.")
(princ "\n * - Matches any character sequence, including an ")
(princ "\n empty one, and it can be used anywhere in the ")
(princ "\n search pattern at the beginning, middle, or end.")
(princ "\n ? - Matches any single character \n")
(princ "\n ~ - If it is the first character in the pattern,")
(princ "\n it matches anything except the pattern.")
(princ "\n [...] - Matches any one of the characters enclosed.")
(princ "\n [~...] - Matches any single character not enclosed.")
(princ "\n - - Used inside brackets to specify a range.")
(princ "\n for a single character.")
(princ "\n , - Separates two patterns.")
(princ "\n ` - Escapes special characters (reads next")
(princ "\n character literally).")
(princ "\n\nPress F2 to close text scren...\n")
(textscr)
); end condition #1
((member laypat:pat '("Q" "q" "_Q" "_q" "Quit" "QUIT" "quit"))
(setq cFlag T laypat:pat "")
); end condition #2
((= laypat:pat "")
(setq laypat:pat oldPat cFlag T)
); end condition #3
(t
(setq cFlag T)
); end condition #4
); end cond
); end while
(if(/= laypat:pat "")
(progn
(setq lLst '()
    actDoc(vla-get-ActiveDocument
        (vlax-get-acad-object))
    ); end setq
(vlax-for l(vla-get-Layers actDoc)
   (if(wcmatch(strcase(vla-get-Name l))(strcase laypat:pat))
    (setq lLst(append lLst(list l)))
    ); end if
   ); end vlax-for
(if lLst
   (progn
(princ(strcat "\n>>> Layers found ("(itoa(length lLst))"): "))
    (princ(strcat (vla-get-Name(car lLst))))
    (foreach l(cdr lLst)
    (princ(strcat ", "(vla-get-Name l)))
    ); end foreach
    (setq Ans "lIst")
    (while(or(= Ans "lIst")(= Ans "Highlight"))
    (initget "On ofF Lock Unlock fReeze Thaw Isolate Previouos Highlight Quit")
    (setq Ans
        (getkword
        "\nSelect option [On/ofF/Lock/Unlock/fReeze/Thaw/Isolate/Previouos/Highlight/Quit] : "))
    (vla-StartUndoMark actDoc)
    (cond
    ((= "On" Ans)
    (StoreLayerStates)
    (mapcar '(lambda(l)(vla-put-LayerON l :vlax-true))lLst)
    ); end condition #2
    ((= "ofF" Ans)
    (StoreLayerStates)
    (mapcar '(lambda(l)(vla-put-LayerON l :vlax-false))lLst)
    ); end condition #3
    ((= "Lock" Ans)
    (StoreLayerStates)
    (mapcar '(lambda(l)(vla-put-Lock l :vlax-true))lLst)
    ); end condition #4
    ((= "Unlock" Ans)
    (StoreLayerStates)
    (mapcar '(lambda(l)(vla-put-Lock l :vlax-false))lLst)
    ); end condition #5
    ((= "fReeze" Ans)
    (StoreLayerStates)
    (mapcar '(lambda(l)(if(not(member(vla-get-Name l)
                (list
                (vla-get-Name
                   (vla-get-ActiveLayer actDoc))
                "0")))
                (vla-put-Freeze l :vlax-true)))
        lLst); end mapcar
    (if(member
        (setq aName(vla-get-Name(vla-get-Activelayer actDoc)))
            (mapcar 'vla-get-Name lLst))
        (princ(strcat "\nCan't freeze active layer '" aName "'! "))
        ); end if
    ); end condition #6
    ((= "Thaw" Ans)
    (StoreLayerStates)
    (mapcar '(lambda(l)(if(not(member(vla-get-Name l)
                (list
                (vla-get-Name
                   (vla-get-ActiveLayer actDoc))
                "0")))
                (vla-put-Freeze l :vlax-false)))
        lLst); end mapcar
    (setvar "CMDECHO" 0)
    (command "_.regenall")
    (setvar "CMDECHO" 1)
    ); end condition #6
    ((= "Isolate" Ans)
    (StoreLayerStates)
    (vlax-for l(vla-get-Layers actDoc)
        (if(not(wcmatch(strcase(vla-get-Name l))(strcase laypat:pat)))
    (vla-put-LayerON l :vlax-false)
    ); end if
        ); end vlax-for
    ); end condition #7
    ((= "Previouos" Ans)
    (if patlay:layerstate
        (progn
        (setq oldLay(vla-get-ActiveLayer actDoc))
        (setvar "CLAYER" "0")
        (mapcar '(lambda(l)
            (vla-put-LayerOn(car l)(cadr l))
            (vla-put-Lock(car l)(nth 2 l))
            (if(not(member(vla-get-Name(car l))
                (list
                (vla-get-Name
                   (vla-get-ActiveLayer actDoc))
                "0")))
                (vla-put-Freeze(car l)(last l))))
        patlay:layerstate); end mapcar
        (if
        (and
           (/= :vlax-true(vla-get-Freeze oldLay))
           (not(vl-catch-all-error-p
            (vl-catch-all-apply 'vla-get-Name
               (list oldLay))))
        ); end and
        (vla-put-ActiveLayer actDoc oldLay)
        ); end if
        (StoreLayerStates)
        ); end progn
        (princ "\nPreviouos layer state missed ")
        ); end if
    ); end condition #8
    ((= "Highlight" Ans)
    (sssetfirst nil(ssget "_X"(list(cons 8 laypat:pat))))
    ); end condition #9
    ((or(not Ans)(= "Quit" Ans))
    (princ "\nQuit LAYPAT ")
    ); end condition #10
    ); end cond
    (vla-EndUndoMark actDoc)
    ); end while
    ); end progn
   (princ "\nNo layers found! ")
   ); end if
); end progn
(setq laypat:pat oldPat)
); end if
(princ)
); end of c:patlay
(princ "\n*** Type PATLAY for wildcard layer actions*** ")