Adjust Lisp to include block on zero layer
@mattv4F4AG wrote:
... this very helpful lisp ... that allows changing layer colors quickly in xrefs or live in a drawings ... doesnt appear to work on blocks where the linework within the block is on the 0 layer. .... its changing the 0 layer color itself but not the color of the layer the block is on. Is there way to make it so if it sees a 0 layer, it goes one level up to the block instead?
....
Yes, (nentsel) "sees" the most-deeply-nested Layer of the sub-object you select, which will be 0 if it was drawn there in the Block definition. You can find the deepest non-0 Layer on which a nested entity resides [where it "appears"] with code that's part of LayerQuellPick.lsp, >here<. Look at the code starting with:
....
(if (= (cdr (assoc 8 edata)) "0"); on Layer 0
....
It "steps up" the Layers of nesting until it finds one that is not 0, and works with that Layer name. That routine turns it off or freezes it, but the same can be used to change its color.
Try this [minimally tested]:
(defun c:clc (/ c d esel edata layc nestlist nlayc)
;; RJP » 2018-08-17; enhanced by Kent Cooper 4 Nov 2022 for nested Layer 0
;; Set layer color by pick
(or (getenv "clc") (setenv "clc" "(62 . 1)"))
(cond
((setq c (acad_truecolordlg (read (getenv "clc"))))
(setenv "clc" (vl-prin1-to-string (last c)))
(setq d (vla-get-activedocument (vlax-get-acad-object)))
(while
(and
(setq esel (nentsel "\nSelect entity to change layer color: "))
(setq edata (entget (car esel)))
); and
(setq layc ; = LAYer to change Color of
(if (= (cdr (assoc 8 edata)) "0"); on Layer 0
(cond ; then
((> (length esel) 2); nested entity [other than Attribute] in Block/Xref
(setq nestlist (last (nentselp (cadr esel)))); stack of references it's nested in
(while
(and
nestlist ; still nesting level(s) remaining
(= (setq nlayc (cdr (assoc 8 (entget (car nestlist))))) "0"); = Nested [non-0] LAYer to change Color of
); and
(setq nestlist (cdr nestlist)); if was 0, move up a level if present
); while
nlayc
; lowest-level non-0 Layer of nested or containing reference(s); 0 if that all the way up
); non-Attribute nested entity on Layer 0 condition
((= (cdr (assoc 0 edata)) "ATTRIB"); Attribute in Block
(cdr (assoc 8 (entget (cdr (assoc 330 edata))))); Block's Layer
); Attribute on Layer 0 condition
("0"); none-of-the-above condition
); cond - then
(cdr (assoc 8 edata)); else - non-0 Layer of entity/nested entity
); if & layc
); setq
(entmod (append (entget (tblobjname "layer" layc)) c))
(vla-regen d acactiveviewport)
); while
); or
); cond
(princ)
)
(vl-load-com)
The main thing is the (setq layc ... part, with slight adjustments to parts of your surrounding code to line up variables to work with that, and add all variables to the localized list.
I don't think it's there yet. If a selected sub-object is nested more than one level deep, then
(last pick)
will be not an entity but a list of the entity names of the Blocks it's nested in, and since that's not an ENAME, it will leave its Layer alone. It looks like it will not look for the lowest-level nesting Block's Layer to change its color [if it's not 0], but will change only the top-most Block's Layer, no matter how many nesting levels there are.
@mattv4F4AG wrote:
@Kent1Cooper If its not too much trouble, could you help me to include the ctrl-z command during the routine to undo a color change if I accidently click a wrong line or block during the routine?
I stole and adjusted that functionality from my ReverseDirection.lsp routine, >here<. It seems to work here, in very limited testing:
;|Change Layer Color by picking object / nested object, but if nested
object's Layer is 0, lowest-level non-0 nesting Layer up from there.
RJP » 2018-08-17, enhanced by Kent Cooper 4 Nov 2022
to prevent of change to nested Layer 0, add individual Undo within.
|;
(defun C:CLC (/ c d n done esel ent edata elay layc nestlist nlayc)
(or (getenv "clc") (setenv "clc" "(62 . 1)")); red first-use default
(cond
((setq c (acad_truecolordlg (read (getenv "clc")))); get color
(setenv "clc" (vl-prin1-to-string (last c)))
(setq
d (vla-get-activedocument (vlax-get-acad-object))
n 0 ; internal Undo counter
); setq
(while (not done)
(setvar 'errno 0)
(if (> n 0) (initget "Undo")); Undo option only if things to undo
(setq esel
(nentsel
(strcat
"\nSelect object to change Layer color, or "
(if (> n 0) "[Undo] " ""); Undo option only if things to undo
"<exit>: "
); strcat
); entsel
); setq
(cond ; overall object-selection or Undo option
((= esel "Undo")
(setq n (1- n))
(command "_.undo" "_back"); revert last color change
); Undo condition
( ; test for selection, unlocked Layer
(and
(= (getvar 'errno) 0); picked something
(setq
ent (car esel)
edata (entget ent)
elay (cdr (assoc 8 edata))
); setq
(= (logand 4 (cdr (assoc 70 (tblsearch "layer" elay)))) 0)
; 0 = unlocked, 4 = locked
); and
(command "_.undo" "_mark")
(setq layc ; = LAYer to change Color of
(if (= elay "0"); on Layer 0
(cond ; then
((> (length esel) 2); nested entity [other than Attribute] in Block/Xref
(setq nestlist (last (nentselp (cadr esel)))); stack of references it's nested in
(while
(and
nestlist ; still nesting level(s) remaining
(= (setq nlayc (cdr (assoc 8 (entget (car nestlist))))) "0"); = Nested [non-0] LAYer to change Color of
); and
(setq nestlist (cdr nestlist)); if was 0, move up a level if present
); while
nlayc
; lowest-level non-0 Layer of nested or containing reference(s); 0 if that all the way up
); non-Attribute nested entity on Layer 0 condition
((= (cdr (assoc 0 edata)) "ATTRIB"); Attribute in Block
(cdr (assoc 8 (entget (cdr (assoc 330 edata))))); Block's Layer
); Attribute on Layer 0 condition
("0"); none-of-the-above condition
); cond - then
elay; else - non-0 Layer of entity/nested entity
); if & layc
); setq
(if (= (logand 4 (cdr (assoc 70 (tblsearch "layer" layc)))) 0); unlocked
(progn ; then
(entmod (append (entget (tblobjname "layer" layc)) c))
(vla-regen d acactiveviewport)
(setq n (1+ n)); for Undo option
); progn
(alert "\nObject's lowest-nested non-0 Layer is locked."); else
); if
); picked-something condition
((= (getvar 'errno) 0); picked something, but ....
(prompt "\nThat object is on a locked Layer --")
); non-qualifying condition
((= (getvar 'errno) 7) (prompt "\nNothing selected --"))
((setq done T)); Enter/space at Select-object prompt [errno = 52]; stop (while) loop
); cond -- selection or U or <exit>
); while
); got-color condition
); cond
(princ)
); defun
(vl-load-com)
Here's an upgrade that also includes a Newcolor option, to change the color that is to be assigned to the Layers of selected objects/nested objects, within the running of the command so you don't need to end it and restart it to get a new color.
