[编程交流] 解锁所有层

( (lambda (/ layer)
   ;;
   ;; (ex) Unlock all layers in drawing using Visual Lisp.
   ;;
   ;; By: Se7en
   ;; 07.28.10 08:11:00 AM 
   ;;
   ;; Licence:
   ;;
   ;;  Copyright (c)2010-2011 John Kaul
   ;;  All rights reserved.
   ;;
   ;;  Redistribution and use in source and binary forms, with or without
   ;;  modification, are permitted provided that the following conditions
   ;;  are met:
   ;;
   ;;   1. Redistributions of source code must retain the above copyright
   ;;      notice, this list of conditions and the following disclaimer.
   ;;   2. Redistributions in binary form must reproduce the above copyright
   ;;      notice, this list of conditions and the following disclaimer in
   ;;      the documentation and/or other materials provided with the
   ;;      distribution.
   ;;
   ;;  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   ;;  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   ;;  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   ;;  FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   ;;  COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   ;;  INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   ;;  BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS
   ;;  OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED
   ;;  AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
   ;;  OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF
   ;;  THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
   ;;  DAMAGE.   
   ;;
   (vlax-for 
       layer
   (vla-get-layers
     (vla-get-activedocument
       (vlax-get-acad-object)))
       (if (vlax-get-property layer 'Lock)
             (vlax-put-property layer 'Lock :vlax-false)))) )

Command: LA
-LAYER
Current layer:  "ALAN"
Enter an option 
[?/Make/Set/New/Rename/ON/OFF/Color/Ltype/LWeight/MATerial/Plot/Freeze/Thaw/LOck
/Unlock/stAte/Description/rEconcile]: U
Enter name list of layer(s) to unlock or <select objects>: *
Enter an option 
[?/Make/Set/New/Rename/ON/OFF/Color/Ltype/LWeight/MATerial/Plot/Freeze/Thaw/LOck
/Unlock/stAte/Description/rEconcile]:

( (lambda ( / )
   ;;
   ;; 
   ;; (ex) Unlock all layers in drawing using Visual Lisp.
   ;;
   ;; By: Se7en
   ;; 07.28.10 08:30:00 AM 
   ;;
   ;; Licence:
   ;;
   ;;  Copyright (c)2010-2011 John Kaul
   ;;  All rights reserved.
   ;;
   ;;  Redistribution and use in source and binary forms, with or without
   ;;  modification, are permitted provided that the following conditions
   ;;  are met:
   ;;
   ;;   1. Redistributions of source code must retain the above copyright
   ;;      notice, this list of conditions and the following disclaimer.
   ;;   2. Redistributions in binary form must reproduce the above copyright
   ;;      notice, this list of conditions and the following disclaimer in
   ;;      the documentation and/or other materials provided with the
   ;;      distribution.
   ;;
   ;;  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   ;;  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   ;;  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   ;;  FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   ;;  COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   ;;  INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   ;;  BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS
   ;;  OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED
   ;;  AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
   ;;  OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF
   ;;  THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
   ;;  DAMAGE.   
   ;;
(vlax-map-collection
   (vla-get-layers (vla-Get-ActiveDocument (vlax-Get-Acad-Object)))
   '(lambda ( layer )
           (if (vlax-get-property layer 'Lock)
            (vlax-put-property layer 'Lock :vlax-true))))) )

( (lambda ( layername / layer lsylst props off freeze lock )
   ;; 
   ;; (ex) Toggle layer's settings in drawing using Auto Lisp.
   ;;
   ;; By: Se7en
   ;; 07.28.10 08:30:00 AM 
   ;;
   ;; NOTES:
   ;; 70 - Standard flags (bit-coded values):
   ;; 1  = Layer is frozen; otherwise layer is thawed
   ;; ...
   ;; 4  = Layer is locked
   ;; ...
   ;; 62 - Color number (if negative, layer is off)
   ;;
   ;; Or if your feeling adventrous you can combine frozen and locked
   ;; (1+4=5). something like...
   ;;
   ;; EXAMPLE:
   ;; (setq laylst (entget (tblobjname "LAYER" "<YOUR LAYER NAME HERE>")))
   ;; (entmod 
   ;;    (subst 
   ;;       (cons 70 (boole 6 (cdr (assoc 70 laylst)) 5)) 
   ;;       (assoc 70 laylst) 
   ;;       laylst))
   ;;
   ;; Licence:
   ;;
   ;;  Copyright (c)2010-2011 John Kaul
   ;;  All rights reserved.
   ;;
   ;;  Redistribution and use in source and binary forms, with or without
   ;;  modification, are permitted provided that the following conditions
   ;;  are met:
   ;;
   ;;   1. Redistributions of source code must retain the above copyright
   ;;      notice, this list of conditions and the following disclaimer.
   ;;   2. Redistributions in binary form must reproduce the above copyright
   ;;      notice, this list of conditions and the following disclaimer in
   ;;      the documentation and/or other materials provided with the
   ;;      distribution.
   ;;
   ;;  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   ;;  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   ;;  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   ;;  FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   ;;  COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   ;;  INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   ;;  BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS
   ;;  OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED
   ;;  AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
   ;;  OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF
   ;;  THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
   ;;  DAMAGE.   
   ;; 
   (setq layer (tblobjname "LAYER" layername))
   (setq laylst (entget layer)
         props (cdr (assoc 70 laylst))
         off (cdr (assoc 62 laylst))
         freeze 1
         lock 4
         )
   (setq props (boole 6 props freeze))
   (setq off (1+ (~ off)))
   (setq props (boole 6 props lock))
   (setq laylst (subst (cons 70 props) (assoc 70 laylst) laylst)
         laylst (subst (cons 62 off) (assoc 62 laylst) laylst))
   (entmod laylst)
   )
"0" ;; just for example. make this a named procedure to use in your library.
)

;;; gc:LayerUnLockAll (gile)
;;; Unlock all layers or relock prevously locked layers
;;;
;;; Argument : T or nil
;;;
;;; Using :
;;; (gc:LayerUnLockAll T) unlock all locked layers
;;; (gc:LayerUnLockAll nil) relock previously unlocked layers
(vl-load-com)
(defun-q
 gc:layerunlockall
 (flag / lst lay)
 (setq lst nil)
 (if flag
   (vlax-for l (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object)))
     (and (= (vla-get-Lock l) :vlax-true)
      (setq lst (cons l lst))
      (vla-put-Lock l :vlax-false)
     )
   )
   (progn
     (foreach n lst
   (vl-catch-all-apply 'vla-put-Lock (list n :vlax-true))
     )
     (setq lst nil)
   )
 )
 (setq    gc:layerunlockall
    (cons (car gc:layerunlockall)
          (cons (list 'setq 'lst (list 'quote lst))
            (cddr gc:layerunlockall)
          )
    )
 )
 lst
)

 (setq    layerunlockall
    (cons (car layerunlockall)
          (cons (list 'setq 'lst (list 'quote lst))
            (cddr layerunlockall)
          )
    )
)

 (setq    [color=Red][b]gc:[/b][/color]layerunlockall
    (cons (car [color=Red][b]gc:[/b][/color]layerunlockall)
          (cons (list 'setq 'lst (list 'quote lst))
            (cddr [b][color=Red]gc:[/color][/b]layerunlockall)
          )
    )
 )