Command: LUA
Unlocks all layers.
Command: LUL
Unlocks layers of selected objects and displays list of just unlocked layers.
Command: LOK
Locks layers of selected objects and displays list of just locked layers.
Code:
;;; ================================================
;;; LAY_LOCK_UNLOCK_v1_00.LSP
;;;
;;; Written by Andrzej Kalinowski, www.autolisps.blogspot.com
;;; v1.00 - 12.11.2017
;;;
;;; Command: LUA - Unlocks all layers
;;; Command: LOK - Locks layers of selected objects and displays list of just locked layers.
;;; Command: LUL - Unlocks layers of selected objects and displays list of just unlocked layers.
;;; ================================================
(defun C:LUA ()
(command "_layer" "u" "*" "") (princ "\nAll layers unlocked") (princ)
);defun
(defun c:LOK ()
(LOK_LUL_COMMON 0)
);defun
(defun c:LUL ()
(LOK_LUL_COMMON 1)
);defun
;;; ================================================
(defun LOK_LUL_COMMON ( mode1 / MyLayers sset1 curobj i1 lay1 laylst fctl)
(vl-load-com)
(setq MyLayers (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)) ) )
(if (= mode1 0)
(prompt "\nSelect ojects to lock layers: ") ;LOK command
(prompt "\nSelect ojects to unlock layers: ") ;LUL command; mode1=1
);if
(if (setq sset1 (ssget) )
;-----------------------------------------
;locking/ unlocking layers
;-----------------------------------------
(progn
(setq laylst (list) )
(repeat (setq i1 (sslength sset1))
(setq curobj (vlax-ename->vla-object (ssname sset1 (setq i1 (1- i1) ) ) ) )
(setq lay1 (vla-get-layer curobj ) );returns string type
(princ lay1)
(if (= nil (member lay1 laylst) );if already exist -it doesnt add it to the list
(setq laylst (cons lay1 laylst) )
);if
(if (= mode1 0)
(vla-put-lock (vla-item MyLayers lay1 ) :vlax-true) ;LOK command
(vla-put-lock (vla-item MyLayers lay1 ) :vlax-false) ;LUL command; mode1=1
);if
);repeat
;-----------------------------------------
;updating fade ctrl
;-----------------------------------------
(terpri)
(setq i1 0 laylst (acad_strlsort laylst) );Sorts a list of strings in alphabetical order
(setq fctl (getvar 'LayLockFadeCtl))
(if (/= fctl 0)
(progn
(setvar 'LayLockFadeCtl (- fctl 1) )
(vla-regen (vla-get-activedocument (vlax-get-acad-object) ) acAllViewports)
(setvar 'LayLockFadeCtl fctl)
);progn
);if
;-----------------------------------------
;Printing list of layers
;-----------------------------------------
(if (= mode1 0)
(princ "\nLocked layers: ") ;LOK command
(princ "\nUnlocked layers: ") ;LUL command; mode1=1
);if
(repeat (length laylst)
(princ (strcat "\t" (nth i1 laylst) ) )
(setq i1 (+ 1 i1))
);repeat
);progn
);if
(princ)
);defun
Example:
Download file: LAY_LOCK_UNLOCK_SEL_OBJCTS_v1_00.FAS

No comments:
Post a Comment