Layer Locks

[will.wydock]

Hi,

I am working on a lisp routine that merges my new work layers into my existing layer for when we reuse the backgrounds. I am able to get the lisp routine work but only if I unlock all layers(including layers that i am not modifying) before running this. Is there either a way to make it so that it will reapply the layer locks or remove this issue from happening?

(DEFUN C:gms-new2exist ()
    (SR:Merge-Layers'
		(
			"M-NAIRDEVICE"
			"M-NAIRDEVICE-HIDDEN"
			"M-NAIRDEVICE-TEXT" 
			"M-NDUCT" 
			"M-NDUCT-HIDDEN"  
			"M-NDUCT-TEXT" 
			"M-NEQUIP"    
			"M-NEQUIP-DIAG"   
			"M-NEQUIP-HIDDEN"
			"M-NEQUIP-TEXT"  
			"M-NPID-DVCE"    
			"M-NPID-SGNL"    
			"M-NPID-TEXT"    
			"M-NPID-WIRE"    
			"M-NOTE"         
			"M-NPIPE"        
			"M-NPIPE-VALV"   
			"M-NPIPE-HIDDEN" 
			"M-NPIPE-TEXT"   
		)
		'(
			"M-XAIRDEVICE"
			"M-XAIRDEVICE-HIDDEN"
			"M-XAIRDEVICE-TEXT" 
			"M-XDUCT" 
			"M-XDUCT-HIDDEN"  
			"M-XDUCT-TEXT" 
			"M-XEQUIP"    
			"M-XEQUIP-DIAG"   
			"M-XEQUIP-HIDDEN"
			"M-XEQUIP-TEXT"  
			"M-XPID-DVCE"    
			"M-XPID-SGNL"    
			"M-XPID-TEXT"    
			"M-XPID-WIRE"    
			"M-XOTE"         
			"M-XPIPE"        
			"M-XPIPE-VALV"   
			"M-XPIPE-HIDDEN" 
			"M-XPIPE-TEXT"   
		)
	)
(PRINC)
)
(defun SR:Merge-Layers (#OldLayers #NewLayers / #Layers)
  (setq #Layers (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))))
  (mapcar
    '(lambda (o n)
       (and (tblsearch "layer" o)
            (or (tblsearch "layer" n) (vla-add #Layers n))
			(command-s "_.-laymrg" "_n" o "" "_n" n "_y")
            ;(vl-cmdf "_.-laymrg" "_n" o "" "_n" n "_y")
       ) ;_ and
     ) ;_ lambda
    #OldLayers
    #NewLayers
  ) ;_ mapcar
) ;_ defun

Thanks in Advanced

[rkmcswain]

Maybe check with @alanjt_ or @Lee_Mac , as it looks like they came up with this code.

http://www.cadtutor.net/forum/showthread.php?43156-Too-many-layers!!!-Need-to-merge-them!

[scot-65]

I'm not sure when and who wrote this block of code but you can manipulate to your liking...

One might need to do a little more work here (line 9 is unclear to me).

 
(defun c:frz-thw (/ layers lay)
  (vl-load-com)
  (setq layers (vla-get-layers
		(vla-get-activedocument
		  (vlax-get-acad-object)
		)
	      )
	)
  (setq lay (vla-add layers "Freeze_Thaw"))
  (if (eq (vla-get-freeze lay) :vlax-true)
    (vla-put-freeze lay :vlax-false)
    )
  (setvar "clayer" "Freeze_Thaw")
  (vlax-for x layers
    (if	(not (eq (vla-get-name x) "Freeze_Thaw"))
      (if (eq (vla-get-freeze x) :vlax-true)
	(vla-put-freeze x :vlax-false)
	(vla-put-freeze x :vlax-true)
      )
    )
  )
  (vla-regen (vla-get-activedocument (vlax-get-acad-object)) acAllViewports)
  (princ "\nLayer Frozen/Thawed states have been flipped....")
  (princ)
)
 

Here are the supplement to the block of code above:

(vla-put-lock (getLayer "LAYER NAME") :vlax-true)
(vla-put-lock (getLayer "LAYER NAME") :vlax-false)
(vla-put-freeze (getLayer "LAYER NAME") :vlax-true)
(vla-put-freeze (getLayer "LAYER NAME") :vlax-false)

If it is determined that a layer is locked, add to a list when unlocking:

(setq a nil)

...

(setq a (cons (list x) a))

...

Then, at the end of the program re-lock using FOREACH:

(foreach x a...

???

[alanjt_]

Step through the layers, if locked, unlock and add to a list.

When command finished, run through list of layers that were originally locked and relock them. I would strongly suggest putting this portion of the code in an error handler, so it resets regardless of how the program ended.

[Ranjit_Singh · Accepted solution]

Try below code and pass arguments x and y as your list of merged layers and list of target layers respectively.

(defun somefunc  (x y / a curvar prelst)
 (setq curvar (mapcar 'getvar (list 'cmdecho 'nomutt 'clayer)))
 (mapcar 'setvar (list 'cmdecho 'nomutt 'clayer) '(0 1 "0"))
 (while (setq a (tblnext "layer" (null a)))
  (setq prelst (cons (cons (assoc 2 a) (list (assoc 70 a))) prelst))
  (entmod (subst (cons 70 (boole 1 (boole 8 4 0) (cdr (assoc 70 a))))
                 (assoc 70 a)
                 (entget (tblobjname "layer" (cdr (assoc 2 a)))))))
 (mapcar '(lambda (x y) (command-s "._-laymrg" "_n" x "" "_n" y "_y")) x y)
 (mapcar '(lambda (x)
           (and (setq a (tblobjname "layer" (cdar x)))
                (setq a (entget a))
                (entmod (subst (cadr x) (assoc 70 a) a))))
         prelst)
 (mapcar 'setvar (list 'cmdecho 'nomutt 'clayer) curvar)
 (princ))