Jump to content

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


ILoveMadoka

Recommended Posts

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.. 😕

 

Link to comment
Share on other sites

(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 by dlanorh
corrected code
Link to comment
Share on other sites

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


 

 

Link to comment
Share on other sites

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 by dlanorh
Link to comment
Share on other sites

19 hours ago, gilsoto13 said:

DotSoft has this one.


 

 

c:CCO - This one works perfectly.

 

Thank you so very much!!

Edited by ILoveMadoka
Link to comment
Share on other sites

  • 3 years later...
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

 

 

  • Thanks 1
Link to comment
Share on other sites

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:

Link to comment
Share on other sites

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 by mhupp
  • Thanks 1
Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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 by jim78b
Link to comment
Share on other sites

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 by mhupp
If 256 color pulls layer color
Link to comment
Share on other sites

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.

 

image.png.724af581b22f4e7f6389df0be8cc5e9d.png

 

 

code updated.

Edited by mhupp
Link to comment
Share on other sites

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

Edited by jim78b
Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...