Change Layers Color To Entity Color

Hi all,

I am looking for a routine to change each layer color to the first entity color in coresponding layer selection set. After that chnge all entities to bylayer color.

So visual efect remain the same but structure different.

For explanation:

I have drawings from architect where all the layers are in white color but entities are in different colors. (All entities in layer have the same color)

If I use drawings as xrefs I am not able to change the entities color by layer manager.

Kind Regards,

Jozef

Hi Josef , please upload your dwg , or send it by mail.

!!!wheretosend.txt

I'm attaching a DWG

RP - I.UQ.X - 5 6. Floor (7.NP) PLan.zip

My idea to lisp solution is:

1. Make list of all used layers (or For each layer...)

2. Select all entities in first (2nd, 3rd...) layer

3. Get first entity of selection

4. Get color of first entity

5. Change layer color by entity color

6. Repeat steps from 2 to 5

7. Change all entities color to bylayer

Kind Regards,

Jozef

Hi Josef, a simple sollution for it ..

Why don't you just make a copy for the xref? - all entities > color bylayer & manipulate whatever you want.

I wouldn't you for a lisp sollution..

Unless yuou were to expect lots of drawings with this same thought.

FWIW

I use some lisps that can do these kinds of things. Can be found on the forum

- fix blocks to make it all 'byblock'

- make layers per blockname

- color layers randomly

Hi Josef, a simple sollution for it ..

Why don't you just make a copy for the xref? - all entities > color bylayer & manipulate whatever you want.

 

 

I wouldn't you for a lisp sollution..

Unless yuou were to expect lots of drawings with this same thought.

 

 

FWIW

I use some lisps that can do these kinds of things. Can be found on the forum

- fix blocks to make it all 'byblock'

- make layers per blockname

- color layers randomly

The problem is that all the layer color is 7.

So if I change all entities > color bylayer, than all antities apears with colour 7.

I need color drawing for orientation in model space and I change only colors for paper space.

Other thought, you could filter by 'color object' and put them in corresponding layer after selection.

I would use two tools for this.

SSO: filter objects tool (Select Same Object)

https://apps.autodesk.com/ACD/en/Detail/Index?id=5630848263328187260&appLang=en&os=Win32_64

in combinations with this to put them into layers 1-10 for the color number afterwards.

Depending on the number of colors used it would take me, i guess, a minute or 10..

(defun c:0 (/ p1) (XYZ_laycmnd "0") (princ))
(defun c:1 (/ p1)  (XYZ_laycmnd "1") (princ))
(defun c:2 (/ p1)  (XYZ_laycmnd "2") (princ))
(defun c:3 (/ p1)   (XYZ_laycmnd "3") (princ))
(defun c:4 (/ p1)  (XYZ_laycmnd "4") (princ))
(defun c:5 (/ p1)  (XYZ_laycmnd "5") (princ))
(defun c:6 (/ p1)   (XYZ_laycmnd "6") (princ))
(defun c:7 (/ p1)   (XYZ_laycmnd "7") (princ))
(defun c:8 (/ p1)   (XYZ_laycmnd "8") (princ))
(defun c:9 (/ p1)   (XYZ_laycmnd "9") (princ))
(defun c:10 (/ p1)  (XYZ_laycmnd "10") (princ))
(defun c:252 (/ p1)  (XYZ_laycmnd "252") (princ))
(defun c:253 (/ p1)  (XYZ_laycmnd "253") (princ))
(defun c:254 (/ p1)  (XYZ_laycmnd "254") (princ))
;;; either change current selection to current layer or start drawing line on current layer
(defun XYZ_laycmnd ( lyr / ss1 p1 idx)
 ;(c:makel)
 (if (and (tblsearch "LAYER" lyr)
          (setq ss1 (ssget "_I"))
     )
   ;; if selection, change to layer
   (repeat (setq idx (sslength ss1))
     (vla-put-layer
       (vlax-ename->vla-object (ssname ss1 (setq idx (1- idx))))
       lyr
     )
   )
   ;; if no selection, start drawing line on layer
   (progn
     (command ".-layer" "set" lyr "on" lyr "")
     (c:lac)
     
;;;      (if (setq p1 (getpoint "LINE From point: "))
;;;        (command "line" p1)
;;;      ) ;if
   ) ;progn
 ) ;if
)

Thank you,

but I do not want to change layers or move objects to new layer.

I want to keep it all as is, just change the color of existing layers.

See attachment.

RP - I.UQ.X - 5 6. Floor (7.NP) PLan.zip

I understand it now.

Does these have to be these colors or can they be random?

Lcolor is a way to do this in a second.

https://plus.google.com/photos/photo/106274025872733696943/6433287340591094418?icm=false&authkey=CImNg9ie3MjrEw&sqid=100517028801245330150&ssid=c0396562-e61c-4b57-97a2-f13e259bb3c6&hl=nl

I understand it now.

Does these have to be these colors or can they be random?

 

 

Lcolor is a way to do this in a second.

 

 

 

 

https://plus.google.com/photos/photo/106274025872733696943/6433287340591094418?icm=false&authkey=CImNg9ie3MjrEw&sqid=100517028801245330150&ssid=c0396562-e61c-4b57-97a2-f13e259bb3c6&hl=nl

Those colors. NO random.

Sorry can't help you any further, i'm not so good at programming such.

Maybe think this Lcolor code might be a good reference for starting the code.

Code can be found here..

http://www.cadtutor.net/forum/showthread.php?97719-Random-colornumbers&highlight=lcolor

Sorry can't help you any further, i'm not so good at programming such.

 

 

Maybe think this Lcolor code might be a good reference for starting the code.

Code can be found here..

 

 

http://www.cadtutor.net/forum/showthread.php?97719-Random-colornumbers&highlight=lcolor

Thank you for your willingness

My idea to lisp solution is:

1. Make list of all used layers (or For each layer...)

2. Select all entities in first (2nd, 3rd...) layer

3. Get first entity of selection

4. Get color of first entity

5. Change layer color by entity color

6. Repeat steps from 2 to 5

7. Change all entities color to bylayer

 

Kind Regards,

Jozef

Hi, if I understand correctly, the following code should do as you ask BUT your drawing has multiple layers with different coloured entities in them, you can see this by stepping through them with LAYWALK. You will still need to do some manual fixing afterwards.

(defun c:laycol ( / lay ss col sblm )
(command "_.undo" "_mark")
(setq lay (cdr (assoc 2 (tblnext "LAYER" T))))
(while lay
 (and (setq ss (ssget "_X" (list (cons 8 lay))))
      (setq col (cdr (assoc 62 (entget (ssname ss 0)))))
      (/= col 0)  ; will not change the layer if the entity colour is bylayer or byblock
      (setq lay (entget (tblobjname "LAYER" lay)))
      (setq lay (subst (cons 62 col) (assoc 62 lay) lay))
      (entmod lay)
 )
 (setq lay (cdr (assoc 2 (tblnext "LAYER"))))
)
(setq sblm (getvar 'setbylayermode))
(setvar 'setbylayermode 1)
(command "_.setbylayer" (ssget "_X" '((0 . "~HATCH"))) "" "" "no") ; ignores hatches & blocks
(setvar 'setbylayermode sblm)
(princ)
)
(princ)

btw, this will take the colour from the last object on each layer, so if a layer has not changed or is not the colour you want draw a new object on that layer in the right colour and run the code again.

Sorry can't help you any further, i'm not so good at programming such.

 

 

Maybe think this Lcolor code might be a good reference for starting the code.

Code can be found here..

 

 

http://www.cadtutor.net/forum/showthread.php?97719-Random-colornumbers&highlight=lcolor

Here's a quick one .. not much error checking.

(defun c:c2l (/ ad b c l lo)
 (vl-load-com)
 (setq ad (vla-get-activedocument (vlax-get-acad-object)))
 (vlax-for x (vla-get-layers ad) (setq l (cons (list (vla-get-name x) x) l)))
 (vlax-for a (vla-get-blocks ad)
   (vlax-for b	a
     (if (and (<= 1 (setq c (vla-get-color b)) 255) (setq lo (assoc (vla-get-layer b) l)))
(progn (vla-put-color (cadr lo) c) (setq l (vl-remove lo l)))
     )
     (vl-catch-all-apply 'vla-put-color (list b 256))
   )
 )
 (princ)
)

I guess that OP is looking for this:

; Colors2Layers - Grrr's practice
(defun C:test ( / _Layer )
 
 (setq _Layer ; Modified From Lee Mac's entmake functions
   (lambda (nm c) 
     (cond
       ( (tblsearch "LAYER" nm) nm)
       ( (entmakex (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") (cons 2 nm) '(70 . 0) (cons 62 c) ) ) nm)
     ); cond
   ); lambda
 ); setq _Layer
 
 (
   (lambda (L)
     (if L
       (mapcar 
         (function 
           (lambda (x / a)
             (setq a (_Layer (strcat "Lcol" (itoa (car x))) (car x)))
             (mapcar 
               (function 
                 (lambda (e / enx)
                   (setq enx (entget e))
                   (entmod (append (vl-remove-if (function (lambda (q) (member (car q) '(62 430)))) (subst (cons 8 a) (assoc 8 enx) enx)) (list (cons 62 256))))
                 ); lambda 
               ); function
               (cdr x)
             ); mapcar
           ); lambda
         ); function
         L
       ); mapcar 
     ); if L
   ); lambda (L)
   (
     (lambda ( / e enx col itm L )
       (setq e (entnext))
       (while e 
         (and (setq enx (entget e)) (/= (cdr (assoc 0 enx)) "VIEWPORT") (setq col (cdr (assoc 62 enx)))
           (cond 
             ( (setq itm (assoc col L)) (setq L (subst (cons (car itm) (cons e (cdr itm))) itm L)) )
             ( (setq L (cons (list col e) L)) )
           ); cond 
         ); and
         (setq e (entnext e))
       ); while 
       L
     ); lambda
   )
 )
 
 (princ)
); defun C:test

I guess that OP is looking for this:

 

; Colors2Layers - Grrr's practice
(defun C:test ( / _Layer )
 
 (setq _Layer ; Modified From Lee Mac's entmake functions
   (lambda (nm c) 
     (cond
       ( (tblsearch "LAYER" nm) nm)
       ( (entmakex (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") (cons 2 nm) '(70 . 0) (cons 62 c) ) ) nm)
     ); cond
   ); lambda
 ); setq _Layer
 
 (
   (lambda (L)
     (if L
       (mapcar 
         (function 
           (lambda (x / a)
             (setq a (_Layer (strcat "Lcol" (itoa (car x))) (car x)))
             (mapcar 
               (function 
                 (lambda (e / enx)
                   (setq enx (entget e))
                   (entmod (append (vl-remove-if (function (lambda (q) (member (car q) '(62 430)))) (subst (cons 8 a) (assoc 8 enx) enx)) (list (cons 62 256))))
                 ); lambda 
               ); function
               (cdr x)
             ); mapcar
           ); lambda
         ); function
         L
       ); mapcar 
     ); if L
   ); lambda (L)
   (
     (lambda ( / e enx col itm L )
       (setq e (entnext))
       (while e 
         (and (setq enx (entget e)) (/= (cdr (assoc 0 enx)) "VIEWPORT") (setq col (cdr (assoc 62 enx)))
           (cond 
             ( (setq itm (assoc col L)) (setq L (subst (cons (car itm) (cons e (cdr itm))) itm L)) )
             ( (setq L (cons (list col e) L)) )
           ); cond 
         ); and
         (setq e (entnext e))
       ); while 
       L
     ); lambda
   )
 )
 
 (princ)
); defun C:test

This is fine but I need to keep original layers and change their colors.

I had a go as well but it did not quite work, like above selected a layer looked for an object and made that layer that object color. One thing though in the dwg some layers had 5 colours so which is correct.

Cool ronjonp. I think this is what TS looking for.

Can you make this work with entities within nested blocks?

Here's a quick one .. not much error checking.

(defun c:c2l (/ ad c l lo)
 (vl-load-com)
 (setq ad (vla-get-activedocument (vlax-get-acad-object)))
 (setq l (vla-get-layers ad))
 (vlax-for a (vla-get-blocks ad)
   (vlax-for b    a
     (if (and (/= 256 (setq c (vla-get-color b)))
          (null (vl-catch-all-error-p
              (setq lo (vl-catch-all-apply 'vla-item (list l (vla-get-layer b))))
            )
          )
     )
   (vla-put-color lo c)
     )
     (vl-catch-all-apply 'vla-put-color (list b 256))
   )
 )
 (princ)
)

I had a go as well but it did not quite work, like above selected a layer looked for an object and made that layer that object color. One thing though in the dwg some layers had 5 colours so which is correct.

Yes, this is a problem with some architectural drawings.

I would use the color that is used for most of entities in layer.

This would mean counting entities with corresponding colors.

Or better solution:

use color of most entities for layer

an create new layer(s) for the rest of colors as "original layer name" + "_col..." and move corresponding entities to them

If it is lot of work, I will be satisfied with one color for layer

I guess that OP is looking for this:

 

; Colors2Layers - Grrr's practice
(defun C:test ( / _Layer )
 
 (setq _Layer ; Modified From Lee Mac's entmake functions
   .
   .
   .
); defun C:test

This is fine and usable for some of cases, but I need to keep original layers