Move objects to new layer(s) based upon color??

[ILoveMadoka]

First of all, I'm not asking anyone to write this for me...

I'm asking if they can point me to an existing routine if it indeed exists..

 

I have a legacy drawing where everything is on Layer 0 and all the entities have colors assigned to them.

 

I am looking for an existing routine <Hopefully!> that will take all the red objects and move them to a new layer called 1 for color 1.

Same thing for each color used in the drawing. 

When done, nothing would be on Layer 0.

 

I've looked and in my searching I've had no luck.

 

= =

 

I did find this:

http://forums.augi.com/showthread.php?110777-Select-by-colour-and-move-to-layer

 

I login to the site, my name appears but when I go to this page, it does not show me logged in (so I cannot look at the code)

I pick Login, it takes me to the main page (and shows me logged in)

I cannot click the link..

 

[dlanorh]

(vl-load-com)

(defun c:lbc (/ c_doc ent obj o_col ss ) 
  (setq c_doc (vla-get-activedocument (vlax-get-acad-object))) 
  (while (setq ent (entsel "\nSelect Object of Color to hide : "))
    (setq obj (vlax-ename->vla-object (car ent)) 
          o_col (vlax-get-property obj 'color)
          ss (ssget "_X" (list '(8 . "0") (cons 62 o_col)))
    );end_setq      
    (vlax-for c_obj (vla-get-activeselectionset c_doc)
      (cond ( (vlax-property-available-p c_obj 'layer T)
        	  (vlax-put-property c_obj 'layer "1");<<==THIS ASSUMES THAT LAYER 1 ALREADY EXISTS IN THE DRAWING
              (vlax-put-property c_obj 'color 256);<<==THIS CHANGES THE COLOR OF THE OBJECT TO BYLAYER
            )
      );end_cond
    );end_for
	);end_while
  (setq ss nil)
);end_defun

Try this. It assumes layer "1" already exists and changes the color of the objects, once moved to bylayer which will reflect the layers color.

If you want the layer created let me know. Its a few lines of code

Edited December 6, 2018 by dlanorh
corrected code

[gilsoto13]

DotSoft has this one.

 

Quote

 

(defun c:cco ()
  (setq cmdecho (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (command "UNDO" "G")
  ;
  (setq sset (ssget))
  (if (/= sset nil)
    (progn
      (setq num (sslength sset) itm 0)
      (while (< itm num)
        (setq hnd (ssname sset itm))
        (setq ent (entget hnd))
        (setq col (cdr (assoc 62 ent)))
        (if (/= col nil)
          (if (and (> col 0)(< col 256))
            (progn
              (setq lay (strcat "M3-" (itoa col)))
              (if (= (tblsearch "LAYER" lay) nil)
                (command "_LAYER" "_N" lay "_C" col lay "")
              )
              (command "_CHPROP" hnd "" "_LA" lay "_C" "BYLAYER" "")
            )
          )
        )
        (setq itm (1+ itm))
      )
      (princ ", Done.")
    )
  )
  ;
  (setq sset nil)
  (command "UNDO" "E")
  (setvar "CMDECHO" cmdecho)
  (princ)
)

 

 

[dlanorh]

Or you could use this, which selects all entities on layer "0" and moves them to a layer named for the integer color value. It will ignore objects with color bylayer or byblock. It creates the layers as it goes.

 

(vl-load-com)

(defun c:lbc (/ c_doc c_lyrs o_col ss n_lyr) 
  (setq c_doc (vla-get-activedocument (vlax-get-acad-object))
        c_lyrs (vla-get-layers c_doc)
        ss (ssget "_X" '((8 . "0")))
  );end_for
  (vlax-for c_obj (vla-get-activeselectionset c_doc)
    (setq o_col (vlax-get-property c_obj 'color))
    (cond ( (and (/= o_col 0) (/= o_col 256)) 
            (cond ( (not (tblobjname "layer" (itoa o_col))) 
                    (setq n_lyr (vla-add c_lyrs (itoa o_col))) 
                    (vlax-put-property n_lyr 'color o_col)
                  )
            );end_cond layer does not exist
            (vlax-put-property c_obj 'layer (itoa o_col))
            (vlax-put-property c_obj 'color 256)
          )  
    );end_cond object colour not bylayer or byblock            
  );end_for
  (setq ss nil)
);end_defun

 

Edited December 6, 2018 by dlanorh

[ILoveMadoka]

19 hours ago, gilsoto13 said:

DotSoft has this one.

 

 

c:CCO - This one works perfectly.

 

Thank you so very much!!

Edited December 6, 2018 by ILoveMadoka

[jim78b]

Please can you that it works with nested blocks and with linetypes? best regards

Edited March 14, 2022 by jim78b

[mhupp]

1 hour ago, jim78b said:

Please can you that it works with nested blocks and with linetypes? best regards

 

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

 

 

[jim78b]

I CHECK not work in nested blocks sorry, and then give me this:

 

Command: LBC
; error: Automation Error. Calling method Clear of interface IAcadSelectionSet failed
Command:

[jim78b]

i need this that work in nested blocks please

[mhupp]

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.

Edited March 17, 2022 by mhupp

[jim78b]

Tomorrow i will try and tell you. I hope works with Nested blocks and all elements. 

[mhupp]

Worked for me, but their are some quarks between BricsCAD and AutoCAD when it comes to lisp.

If nothing else you could just use quick select to select everything by color. moving them to their assigned layers.

[ILoveMadoka]

Just saw that this old thread has been updated and wanted to say...

 

You guys are awesome!!

[jim78b]

hello sorry don't work, i have also nested blocks

 

C:LAYERCOLOR
Command: LAYERCOLOR
; error: bad DXF group: (62 . 256.0)
Command:

 

thanks for the time dedicated to me

Edited March 15, 2022 by jim78b

[mhupp]

This should get all blocks even the nested ones. it has *paper_Space and *model_space as blocks that needed to be removed. it might error on other anonymous blocks.

256 is color of bylayer. a layer cant be set to that so if the entity has 256 color it will be changed to 7 or White.

 

(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)
)

 

Edited March 16, 2022 by mhupp
If 256 color pulls layer color

[jim78b]

C:LAYERCOLOR
Command: LAYERCOLOR
; error: bad DXF group: (62 . 7.0)

 

sorry

[mhupp]

like I said quarks between BricsCAD and Autocad. Works over on my end. Switching where the itoa function is should work then.

Never mind I was using atof that returns 7.0 instead of atoi for 7. But seems bricscad doesn't care if its 7.0 or 7 it will take either.

 

 

 

code updated.

Edited March 15, 2022 by mhupp

[jim78b]

Sorry i am not expert in lisp ..should i change something in your code ?

[mhupp]

Was just saying what was causing the error. the code has ben updated already.

Edited March 15, 2022 by mhupp

[jim78b]

i tried , but the cursor lock on loading icon i must restart autocad with CTRL+ALT+CANC!

Edited March 16, 2022 by jim78b