;; ==================================================================== ;;
;; ;;
;; PATLAY.LSP - Allows to select group of layers with the help ;;
;; of wildcard pattern string and to do with them ;;
;; following actions: On/Off, Lock/Unlock, ;;
;; Freeze/Thaw, Highlight (select). ;;
;; ;;
;; ==================================================================== ;;
;; ;;
;; Command(s) to call: PATLAY ;;
;; ;;
;; Specify wildcard string and do action with layers selected ;;
;; ;;
;; ==================================================================== ;;
;; ;;
;; THIS PROGRAM AND PARTS OF IT MAY REPRODUCED BY ANY METHOD ON ANY ;;
;; MEDIUM FOR ANY REASON. YOU CAN USE OR MODIFY THIS PROGRAM OR ;;
;; PARTS OF IT ABSOLUTELY FREE. ;;
;; ;;
;; THIS PROGRAM PROVIDES 'AS IS' WITH ALL FAULTS AND SPECIFICALLY ;;
;; DISCLAIMS ANY IMPLIED WARRANTY OF MERCHANTABILITY OR FITNESS ;;
;; FOR A PARTICULAR USE. ;;
;; ;;
;; ==================================================================== ;;
;; ;;
;; V1.2, 22nd Aug 2008, Riga, Latvia ;;
;; © Aleksandr Smirnov (ASMI) ;;
;; For AutoCAD 2000 - 2009 (isn't tested in a next versions) ;;
;; ;;
;; http://www.asmitools.com ;;
;; ;;
;; ==================================================================== ;;

(defun c:LGM(/ 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] : ")))
(cond
((member laypat:pat '("H" "h" "_H" "_h" "Help" "HELP" "help"))
(princ "\n <<>> \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[Info] http:\\\\www.AsmiTools.com [Info]")
(princ "\n[Info] Type LGM for wildcard layer actions. [Info]")
(c:lgm)

Advertisements