The first rule of LISP, is that LISP may not always the best tool for the job.
Rather than using LISP to change a layer's color, consider using the LAYMRG Command to merge an undesired layer (and the entities on it) into one of your standard layers (and effectively remove the undesired layer from the drawing). Of course, you could always isolate layers and change their layer to the correct standard layer as well (SETBYLAYER Command may still be required).
If you're getting drawings like this frequently, then you might also consider the LAYTRANS Command to do the grunt work for you en-mass.
Now, if you're still interested in a LISP routine, and assuming you've already run SETBYLAYER to mitigate entity overrides, this old LISP routine will help you to change one or more Layer colors using standard color index:
Code:
(vl-load-com)
(defun c:CLC () (c:ChangeLayerColor))
(defun c:ChangeLayerColor
(/ *error* ss color acDoc oLayers oLayer layers regen)
(princ "\rCHANGELAYERCOLOR ")
(defun *error* (msg)
(if acDoc
(progn
(vla-endundomark acDoc)
(if regen
(vla-regen acDoc acAllViewports)
)
)
)
(cond ((not msg)) ; Normal exit
((member msg '("Function cancelled" "quit / exit abort"))) ; <esc> or (quit)
((princ (strcat " ** Error: " msg " ** ")))
) ; Fatal error, display it
(princ)
)
(if (not (setq ss (ssget "_i")))
(progn
(prompt "\nSelect entity on layer to change color: ")
(setq ss (ssget))
)
)
(if (= 1 (sslength ss))
(setq color
(cdr
(assoc 62
(tblsearch "layer"
(cdr (assoc 8 (entget (ssname ss 0))))
)
)
)
)
)
(if
(and ss
(princ "\nSelect replacement layer color: ")
(setq color (acad_colordlg
(if color
color
1
)
nil
)
)
)
(progn
(vla-startundomark
(setq acDoc (vla-get-activedocument (vlax-get-acad-object)))
)
(setq oLayers (vla-get-layers acDoc))
(vlax-for x (setq ss (vla-get-activeselectionset acDoc))
(if
(not
(vl-position
(setq oLayer (vla-item oLayers (vla-get-layer x)))
layers
)
)
(setq layers (cons oLayer layers))
)
)
(vla-delete ss)
(foreach oLayer layers
(if (or regen
(= :vlax-true (vla-get-lock oLayer))
)
(setq regen T)
)
(vla-put-color oLayer color)
(vla-put-lineweight oLayer aclnwtbylwdefault)
)
)
)
(*error* nil)
)
Or, if you'd instead like to simply move the selected entities to one of your standard layers (which already has the correct color assignment), and set the entities to ByLayer color in one step, you could use this old routine, which will also get-or-create the layer name you enter, remembers the last layer you entered (per drawing), and supports undo functionality (for when you fat-finger a layer name typo Haha):
Code:
(vl-load-com)
(defun c:MOLAY () (c:MoveToLayer))
(defun c:MoveToLayer (/ *error* layerName acDoc oLayer ss)
(princ "\rMOVETOLAYER ")
(defun *error* (msg)
(if ss (vla-delete ss))
(if acDoc (vla-endundomark acDoc))
(cond ((not msg)) ; Normal exit
((member msg '("Function cancelled" "quit / exit abort"))) ; <esc> or (quit)
((princ (strcat "\n** Error: " msg " ** "))) ; Fatal error, display it
)
(princ)
)
(if
(and
(ssget "_:L")
(or (/= ""
(setq layerName
(strcase
(getstring
T
(strcat "\nMove selection to layer name "
(if *MoveToLayerName*
(strcat " <" *MoveToLayerName* ">: ")
": "
)
)
)
)
)
)
(setq layerName *MoveToLayerName*)
)
(setq *MoveToLayerName* layerName)
)
(progn
(vla-startundomark
(setq acDoc (vla-get-activedocument (vlax-get-acad-object)))
)
(setq oLayer (vla-add (vla-get-layers acDoc) layerName))
(vlax-for x (setq ss (vla-get-activeselectionset acDoc))
(vl-catch-all-apply 'vla-put-color (list x acbylayer))
(vla-put-layer x layerName)
)
)
)
(*error* nil)
)
Cheers