Change layer color by selection, changes on the fly

[mpa-la]

I have a lisp routine I use A LOT, where you pick an object (or multiple objects), then enter the color you want to change the layer(s) to. Works great, a Cadalyst routine, posted at the bottom in case it might help.  Problem being, if you want to change say 10 layers, there is no feedback when you pick, so it's hard to tell if you have selected everything you want.  It would be better if I entered the desired color first, and it changes on-screen as soon as you pick the object, so you can see what you've changed.  The routine wouldn't exit automatically so that you could continue picking objects.  Is this possible, or pie in the sky?  Thanks!!

;;; CADALYST 04/08  www.cadalyst.com/code
;;; Tip 2278: XR-LAYCOL.LSP    Change Xref Layer Color    (c) 2008 Raymnond Rizkallah

;;;====================================================================
;;; [C:xrcc] Function to change XREF's LAYER COLOR, extracting Layers name
;;; by picking objects.
;;;
;;; By Raymond RIZKALLAH - Oct./2007
;;;====================================================================
(defun C:xrc ()
  (setq laylst nil)
  (while
    (setq entsll
       (nentsel "\n   Select object on the layer to be COLORED: ")
    )
     (setq laynam (cdr (assoc 8 (entget (car entsll)))))
     (if (null laylst)
       (setq laylst laynam)
       (setq laylst (strcat laylst "," laynam))
     )
     (prompt (strcat "\n   {" laylst "}"))
  )                    ;end while
  (if
    (= (getvar "tilemode") 1)
     (progn
       (if laylst
     (progn
       (setq lay-col (getint "\nNew Layers Color: "))
       (command "layer" "c" lay-col laylst "")
     )
       )
     )
     (progn
       (if laylst
     (progn
       (setq lay-col (getint "\nNew Layers Color: "))
       (command ".Vplayer" "Color" lay-col laynam "Current" "")
     )
       )
     )
  )
  (princ)
)

[ВeekeeCZ · Accepted solution]

It could be a good example to learn some.... its quite ease to do that.

(defun C:xrc ()
  (setq lay-col (getint "\nNew Layers Color: "))
  (while 
    (setq entsll
       (nentsel "\n   Select object on the layer to be COLORED: ")
    )
     (setq laynam (cdr (assoc 8 (entget (car entsll)))))
;;;     (if (null laylst)
;;;       (setq laylst laynam)
;;;       (setq laylst (strcat laylst "," laynam))
;;;     )
;;;     (prompt (strcat "\n   {" laylst "}"))
  (if
    (= (getvar "tilemode") 1)
     (progn
       (if laynam
     (progn
       (command "layer" "c" lay-col laynam "")
     )
       )
     )
     (progn
       (if laynam
     (progn
       ;(setq lay-col (getint "\nNew Layers Color: "))
       (command ".Vplayer" "Color" lay-col laynam "Current" "")
     )
       )
     )
  ))
  (princ)
)

[mpa-la]

Wow, that's perfect!  Thanks so much!

[Kent1Cooper · Accepted solution]

There's a lot of unnecessary code in that, particularly (progn) "wrapper" functions that are not needed [because they "wrap" only a single function], and when adjusted for change-as-you-go use, even the (if) functions that test whether there's a Layer name are extraneous, because the test will always be satisfied [i.e. every selectable object has a Layer].

But the "danger" I see is in pulling the Layer name directly from the entity part of the result of (nentsel).  The (nentsel) function "sees" the deepest-nested  element you pick on.  Many people draw elements in most Blocks on Layer 0 so that they will take on the characteristics of the Layers on which the Blocks are Inserted.  That means that when you pick on a part that was drawn on Layer 0, inside a Block, no matter what Layer the Block is inserted on or whether it's nested in any other Block(s) to any level, the routine will change the color of Layer 0, not of what you think you're picking on!

What it should do is to check whether the deepest-nested element is on Layer 0, and if it is, step up to the Layer on which the deepest-nested Block [that it's a part of] is inserted, and check whether that's Layer 0, and keep stepping up until it finds a Layer name other than 0, and assign the color to that, or use 0 only if that's still the Layer all the way up to the top level.  [That part makes up the bulk of the code below.]

It would also be preferable to use the color dialog box, rather than ask for an integer, because it prevents too-large integers, non-integer inputs [decimal, or text, or...], ByLayer/ByBlock [256/0], negative integers, etc.

Here's a way to do all of that [lightly tested]:

(defun C:LCP (/ esel ent edata lay nestlist nlay); = Layer Color assignment by Picking object(s)
  (setq *LCPcol (acad_colordlg (cond (*LCPcol) (7)) nil))
  (while
    (setq esel
      (nentsel (strcat "\n Select object on Layer to give color " (itoa *LCPcol) ": "))
    ); setq
    (setq
      ent (car esel)
      edata (entget ent)
      lay
        (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 nested in
              (while
                (and
                  nestlist ; still nesting level(s) remaining
                  (= (setq nlay (cdr (assoc 8 (entget (car nestlist))))) "0"); = Nested LAYer still 0?
                ); and
                (setq nestlist (cdr nestlist)); move up a level if present
              ); while
              nlay ; = lowest-level non-0 Layer of nested or containing reference(s);
                ; uses 0 if it's 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 - Layer of entity/nested entity
        ); if & lay
    ); setq
    (if (= (getvar "tilemode") 1)
      (command "_.layer" "_color" *LCPcol lay "") ; then
      (command "_.vplayer" "_color" *LCPcol lay "_current" "") ; else
    ); if
  ); while
  (princ)
); defun

[mpa-la]

Hi Kent, thanks for your input and explanation.  We actually have a different version of the original lisp routine (XRC) that works for blocks for just the reasons you list.  The only thing we've never been able to address are blocks in xrefs.  Finally just gave up and do those manually.  I wasn't worried about that for this lisp routine, because when I have multiple layers to change the color of, they're usually not blocks or blocks in xrefs, so the initial solution works perfectly for me.  The only thing I would change is that I wish it would remember the value so I don't have to retype it when I miss something and have to go back.  I plan on looking up how to do that and addressing it myself - try to learn a little...

I tried the routine you posted, but I'm getting a malformed list on input error when I try to load it.

[mpa-la]

I take that back, it's working fine!  Paste error!!

[mpa-la]

Holy cow your routine is awesome!!  It works on blocks and blocks in xrefs.  I'm woozy 🙂