Looking for a layers tool lisp

I'm looking for a tool or lisp that would allow changing the color of a
layer by selecting an object, which would then prompt you to select a color
for the layer which the selected object is on. I used to have a tool that
used to do this but can't find it, it may have been a lisp from an old
softdesk version (a "retired" command?).

Any ideas?

Thanks for any help - Patrick

 

Try this.

(defun c:CLC ()
(prompt "\nSelect layer whose color will be changed... ")
(setq a (cdr (assoc 8 (entget (car (entsel))))))
(setq aa (rtos (cdr (assoc 62 (tblsearch "layer" a))) 2 0))
(setq aaa (strcat "\nLayer " a " is colored " aa " ...new color? "))
(princ aaa)
(setq b (getstring)) ; String, so you can input "green" or 3
(command "-layer" "c" b a "")
(princ)
)

Apologies to RRB who would like to burn my a aa aaa variables.<g>

 

I forget who wrote this (apologies to whomever) but the best thing about it
that you can pick entities at the block or nested level (including xrefs)
and change a layer color without forcing a regen.

(defun c:lc (/ en1 chk olst nlst bnm cde
blst lyr lyrc col llist olderr lc_errtrap
)

(defun lc_errtrap (s)
(if (/= s "Function cancelled")
(princ (strcat "\nError: " s))
)
(command "UNDO" "EN")
(setq *error* olderr)
(princ)
)
(setq
olderr *error*
*error* lc_errtrap
)

(setvar "ERRNO" 0)
(setq en1 nil)
(setq
nestsel nentsel
nestprompt
"\nno Nesting/Select Nested Object on Layer to Change> : "
)
(command "UNDO" "BE")
(while (and (= (getvar "ERRNO") 0) (not en1))
(initget "N")
(setq en1 (nestsel nestprompt))
(if en1
(cond
((= en1 "N")
(if (= nestsel entsel)
(setq
nestsel nentsel
nestprompt
"\nno Nesting/Select Nested Object on Layer to Change> : "
)
(setq
nestsel entsel
nestprompt
"\nNested/Select Object on Layer to Change> : "
)
)
(setq en1 nil)
)

((= (type en1) 'list)
;;;----------------------
;;;swiped this from ET's xlist.lsp 7-12-01
(setq inest (length (last en1)))
;;The next if statement handles block within blocks. iNest = 1 means no
nesting. Since (nentsel) goes all the
;;way to the root AutoCAD object we have to traverse back up to the top
level of the nesting to get a block name.
(if (and (> inest 1) (= 'ename (type (car (last en1)))))
(setq nlst (entget (nth (- inest 2) (last en1))))
;;else last last our way back up to the top block definition
(setq nlst (entget (car en1)))
;;then pull the list from the standard nentsel call.
)
;;;----------------------
(setq chk (car (last en1)))
(setq olst (entget (car en1)))
(if (and (= (type chk) (quote ename)) (> inest 1))
(progn
(if (not nlst)
(setq nlst (entget (car (last en1))))
)
(setq bnm (cdr (assoc 2 nlst)))
(setq blst (tblsearch "BLOCK" bnm))
(setq cde (cdr (assoc 70 blst)))
(cond ((= cde 0) (setq flist nlst))
((= cde 2) (setq flist olst))
((= cde 44) (setq flist olst))
((= cde 48) (setq flist nlst))
((= cde 50) (setq flist nlst))
((= cde 36) (setq flist olst))
)
)
(setq flist olst)
)
(setq lyr (cdr (assoc 8 flist)))
(setq lyrc (cdr (assoc 62 (tblsearch "LAYER" lyr))))
(princ
(strcat "\n\nSelecting Color for Layer " lyr " .......\n")
)
(setq col (acad_colordlg (abs lyrc) nil))
(if (not col)
(exit)
(progn
(setq llist (entget (tblobjname "LAYER" lyr)))
(setq llist (subst (cons 62 col) (assoc 62 llist) llist))
(entmod llist)
)
)
(setvar "ERRNO" 0)
(setq en1 nil)
)
(t (princ))
)
(if (= (getvar "ERRNO") 7)
(setvar "ERRNO" 0)
)

)
)
(command "UNDO" "EN")
(setq *error* olderr)
(princ)
)

 

this is what I use


(DEFUN C:colo (/ E VLAOBJ OB CO)
(setq e (CAR
(nentsel "\nSelect nested xref or object to change color by layer: ")
)
)

(setq vlaobj
(vlax-ename->vla-object e)
)
(setq ob
(vlax-get-property vlaobj 'LAYER)
)

(SETQ CO (GETSTRING "\nWHAT COLOR NUMBER! : "))
(COMMAND "-LAYER" "COLOR" CO OB "")
(PRINC)
)

 

YES!, scare the user into submission...

 

Thanks for the help! I'm sure one (or all) of these will make my life
easier.

Thanks again - Patrick