Leaderboard

Sorry I was mistaking @jim78b for the original poster. Try this. don't worry about making layers first. this will make them as needed. might error if they are true colors and not 0 - 256. (defun C:LayerColor (/ SS ent lay e blkname blklst entlst lst) (vl-load-com) (if (setq SS (ssget "_X" '((8 . "0") (-4 . "<NOT") (0 . "INSERT") (-4 . "NOT>") (410 . "Model")))) (foreach obj (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS))) (setq ent (vlax-ename->vla-object obj)) (if (and (setq lay (itoa (vla-get-Color ent))) (= lay "256")) (setq lay (itoa (cdr (assoc 62 (tblsearch "layer" (vla-get-Layer ent)))))) ) (if (not (tblsearch "layer" lay)) (entmake (list (cons 0 "LAYER") (cons 100 "AcDbSymbolTableRecord") (cons 100 "AcDbLayerTableRecord") (cons 2 lay) (cons 62 (atoi lay)) (cons 70 0) ) ) ) (vla-put-layer ent lay) ) ) (if (setq blklst (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))) (progn (vlax-for blk blklst (and (eq "AcDbBlockReference" (vla-get-ObjectName blk))) (setq lst (cons (vla-get-Name blk) lst)) ) (setq lst (vl-remove "*Paper_Space" lst)) (setq lst (vl-remove "*Model_Space" lst)) (foreach blkname lst (setq ent (tblobjname "BLOCK" blkname)) (while (setq ent (entnext ent)) (setq entlst (cons ent entlst)) ) (foreach ent entlst (setq ent (vlax-ename->vla-object ent)) (if (and (setq lay (itoa (vla-get-Color ent))) (= lay "256")) (setq lay (itoa (cdr (assoc 62 (tblsearch "layer" (vla-get-Layer ent)))))) ) (if (not (tblsearch "layer" lay)) (entmake (list (cons 0 "LAYER") (cons 100 "AcDbSymbolTableRecord") (cons 100 "AcDbLayerTableRecord") (cons 2 lay) (cons 62 (atoi lay)) (cons 70 0) ) ) ) (vla-put-layer ent lay) ) ) ) ) (princ) ) updated code so if there is multiple of the same block it only gets processed once.

Not saying these lisps works with nested items but did you Regen after the command? blocks won't update unless you regen or during editing. also

I asked @pBe to help me on this before... see if this works for you... ;;; Color to Bylayer ;;; (Defun c:ctl ( / _makelay LayerColor i ss) ;;; pBe 19 Mar 2015 ;;; (defun makelay (l c) (entmake (list (cons 0 "LAYER") (cons 100 "AcDbSymbolTableRecord") (cons 100 "AcDbLayerTableRecord") (cons 2 l) (cons 70 0) (cons 62 (if (zerop c) 7 c)) ) ) ) (defun _LayerColor (e lst) (if (setq f (assoc (setq c (cdr (assoc 62 e))) lst)) (progn (if (not (tblsearch "LAYER" (setq ln (cdr f)))) (makelay ln (car f))) (entmod (append e (list (cons 8 ln)'(62 . 256)))) ) (progn (makelay (itoa c) c) (setq lst (cons (cons c (itoa c)) lst)) (_LayerColor e lst) ) ) lst ) (or clist (setq clist '((0 . "ColorByBlock")(1 . "Red")(2 . "Yellow") (3 . "Green")(4 . "Cyan") (5 . "Blue")(6 . "Magenta") (7 . "White")))) (if (setq ss (ssget "X" '((8 . "0") (-4 . "/=") (62 . 256)))) (repeat (setq i (sslength ss)) (setq l (entget (ssname ss (setq i (1- i))))) (setq clist (_LayerColor l clist)) ) ) (princ) )

(vl-load-com) (defun c:classify ( / ss ssl index obj color linetype linetypescale str layertable newlayername) (princ "\n select object to classify") (setq layertable (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))) (if (setq ss (ssget)) (progn (setq ssl 0) (setq ssl (sslength ss)) (setq index 0) (setq str "") (repeat ssl (setq obj (vlax-ename->vla-object (cdr (assoc -1 (entget (ssname ss index)))))) (setq color (vla-get-color obj)) (if (= color 256) ; if by layer (setq color (cdr (assoc 62 (tblsearch "LAYER" (vla-get-layer obj))))) ) (setq color (vl-princ-to-string color)) (setq linetype (vl-princ-to-string (vla-get-linetype obj))) (if (= linetype "ByLayer") ; if by layer (setq linetype (cdr (assoc 6 (tblsearch "LAYER" (vla-get-layer obj)) ) ) ) ) (setq linetype (vl-princ-to-string linetype)) (setq linetypescale (vl-princ-to-string (vla-get-linetypescale obj))) (setq str (strcat "color-" color "_lt-" linetype "_lts-" linetypescale)) (if (= (tblsearch "LAYER" str) nil) (progn (setq newlayername (vla-add layertable str)) (vla-put-color newlayername color) (vla-put-linetype newlayername linetype) ;(vla-put-linetypescale newlayername linetypescale) (vlax-put-property obj 'layer str) (vla-put-color obj 256) (vla-put-linetype obj "ByLayer") ); end of progn (progn (setq newlayername (vla-item layertable str)) (vlax-put-property obj 'layer str) (vla-put-color obj 256) (vla-put-linetype obj "ByLayer") ); end of progn ); end of if (setq index (+ index 1)) );end of repeat );end of progn );end of if (princ) );end of defun how about approach like this. - code updated, layer cannot have linetype scale value. my mistake. works like below

Sort of understand what you want, need more detail new layer names, NEW-1-cent-1-5 ?