Change Layers Color To Entity Color

[BIGAL]

Here is another version it changes some layers, but still suffers from the fact that some layers object colour is white. I used a simple layer test by looking for a line or pline. I was previously trying to be too smart and looking at various objects. I have made the code a load once so no keyboard entry required. I just pasted the lisp from explorer into the dwg. I would normally have it as a menu option.

 

If you want to force non white then it would require looping through the objects till the colour is not "Bylayer" or white "7" version 2 ? Using the most items for a color is a good idea a big coding overhead as the total number of layers is not that many.

 

(defun col-lay ( / ss col doc obj )
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(setq col "1")
(vlax-for lay (vla-get-Layers doc)
(if (/= (setq ss (ssget "x" (list (cons 0 "*line")(cons 8 (vla-get-name lay))))) nil)
(progn
(setq obj (vlax-ename->vla-object (ssname ss 0))) ; 1st object 
(setq col (LM:ParseNumbers (vla-get-PlotStyleName obj)))
(command "-layer" "c" (nth 0 col) (vla-get-name lay) "")
(setq ss nil)
)
)
)
(alert "All done \nJust select all and make Bylayer")
(princ)
)

;;-------------------=={ Parse Numbers }==--------------------;;
;;                                                            ;;
;;  Parses a list of numerical values from a supplied string. ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  s - String to process                                     ;;
;;------------------------------------------------------------;;
;;  Returns:  List of numerical values found in string.       ;;
;;------------------------------------------------------------;;

(defun LM:ParseNumbers ( s )
 (
   (lambda ( l )
     (read
       (strcat "("
         (vl-list->string
           (mapcar
             (function
               (lambda ( a b c )
                 (if
                   (or
                     (< 47 b 58)
                     (and (= 45 b) (< 47 c 58) (not (< 47 a 58)))
                     (and (= 46 b) (< 47 a 58) (< 47 c 58))
                   )
                   b 32
                 )
               )
             )
             (cons nil l) l (append (cdr l) (list nil))
           )
         )
         ")"
       )
     )
   )
   (vl-string->list s)
 )
)
; starts here
(col-lay)

Edited June 20, 2017 by BIGAL

[Jozef13]

Here is another version it changes some layers, but still suffers from the fact that some layers object colour is white. I used a simple layer test by looking for a line or pline. I was previously trying to be too smart and looking at various objects. I have made the code a load once so no keyboard entry required. I just pasted the lisp from explorer into the dwg. I would normally have it as a menu option.

 

If you want to force non white then it would require looping through the objects till the colour is not 256 or white. Using the most items for a color is a good idea a big coding overhead as the total number of layers is not that many.

 

(defun col-lay ( / ss col doc obj )
........

 

Thanks, I will try it in the evening, because I am currently at work with only AutoCAD LT

[ronjonp]

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

Can you make this work with entities within nested blocks?

 

It should do that already.

[tive29]

It should do that already.

 

I tested it a 2nd time. Did not work when the entity is in block.

[ronjonp]

Give it a try now, I updated the code .. had one line in the wrong loop.

[Jozef13]

Here is another version it changes some layers, but still suffers from the fact that some layers object colour is white. I used a simple layer test by looking for a line or pline. I was previously trying to be too smart and looking at various objects. I have made the code a load once so no keyboard entry required. I just pasted the lisp from explorer into the dwg. I would normally have it as a menu option.

 

If you want to force non white then it would require looping through the objects till the colour is not "Bylayer" or white "7" version 2 ? Using the most items for a color is a good idea a big coding overhead as the total number of layers is not that many.

 

(defun col-lay ( / ss col doc obj )
.
.
.
(col-lay)

 

Thank you very much.

This work perfect.

I am stisfied.

It would be nice to create layers with color suffix to cover all colors in layer but do not loose the time if it is a big coding.

[Jozef13]

Give it a try now, I updated the code .. had one line in the wrong loop.

 

Thank you very much.

This work also perfect.

I am stisfied.

It would be nice to create layers with color suffix to cover all colors in layer but do not loose the time if it is a big coding.

[tive29]

Give it a try now, I updated the code .. had one line in the wrong loop.

 

Thank you ronjonp

[ronjonp]

Thank you very much.

This work also perfect.

I am stisfied.

It would be nice to create layers with color suffix to cover all colors in layer but do not loose the time if it is a big coding.

Give this a try .. should increment layer names with the color number.

(defun c:c2l (/ ad c l lays lo lyr n)
 (vl-load-com)
 (setq ad (vla-get-activedocument (vlax-get-acad-object)))
 (vlax-for x (setq lays (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
     (setq lyr (vla-get-layer b))
     (if (<= 1 (setq c (vla-get-color b)) 255)
(cond ((setq lo (assoc lyr l)) (vla-put-color (cadr lo) c) (setq l (vl-remove lo l)))
      ((setq lo (vla-add lays (setq n (strcat lyr "_" (itoa c)))))
       (vla-put-color lo c)
       (setq l (cons (list n lo) l))
      )
)
     )
     (vl-catch-all-apply 'vla-put-color (list b 256))
   )
 )
 (princ)
)

[ronjonp]

Thank you ronjonp

You're welcome.

[Jozef13]

Give this a try .. should increment layer names with the color number.

(defun c:c2l (/ ad c l lays lo lyr n)
 (vl-load-com)
 (setq ad (vla-get-activedocument (vlax-get-acad-object)))
 (vlax-for x (setq lays (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
     (setq lyr (vla-get-layer b))
     (if (<= 1 (setq c (vla-get-color b)) 255)
(cond ((setq lo (assoc lyr l)) (vla-put-color (cadr lo) c) (setq l (vl-remove lo l)))
      ((setq lo (vla-add lays (setq n (strcat lyr "_" (itoa c)))))
       (vla-put-color lo c)
       (setq l (cons (list n lo) l))
      )
)
     )
     (vl-catch-all-apply 'vla-put-color (list b 256))
   )
 )
 (princ)
)

 

Hi,

it fine increment layer names with the color number but I need also to move coresponding entities to created layers otherwise the result is different as you can see in attached picture.

[ronjonp]

Add (vla-put-layer b n) after (vla-put-color lo c).

[Jozef13]

Add (vla-put-layer b n) after (vla-put-color lo c).

 

Brilliant !!!. Your code is short and poverfull.

My admiration .

Just small error occurred: "; error: Automation Error. On locked layer"

If I unlock the layers before it work fine.

Is it possible to unlock layers in code and lock back to original state after modification?

[ronjonp]

Brilliant !!!. Your code is short and poverfull.

My admiration .

Just small error occurred: "; error: Automation Error. On locked layer"

If I unlock the layers before it work fine.

Is it possible to unlock layers in code and lock back to original state after modification?

Let's see if you can figure out that small part Here's a hint (vla-put-lock x :vlax-false) .. you'll have to store what layers are unlocked so you can restore them after the code runs.

[edal]

Hey, I'm in the same situation as OP, but the colors i need set to the layer are truecolors (rgb(x,y,x)). 

 

Any edit to this script to make it work with truecolors? 

 

Tried to google and tinker with the original script, but this is my fist time seeing lisp code and I'm totally lost. 

[ronjonp]

@edal

You want something like this?

(defun c:foo (/ co)
  (vlax-for l (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
    (setq co (vla-get-truecolor l))
    (vla-setrgb co (vla-get-red co) (vla-get-green co) (vla-get-blue co))
    (vla-put-truecolor l co)
  )
  (princ)
)

 

[edal]

@ronjonp Thanks alot for the quick reply.  

 

The colorconversion part is correct. Problem is that the layers have a specified color, while the layers features have a specified rbg-color that is not by layer. I wasn't very specific when bringing this up, so i'll try to specify.

 

So the goal is to get the color from the features of a layer and then set the layers color to the color fetched from a feature. 

In my example the layers color is "white", but it contains features colored as eg: 209,217,174.

I would like the layers color to be 209,217,174.

 

From earlier in this thread this was posted: 

 

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

 

The above code seems to have the functionality i'm looking for, except that it doesn't play well when the features colors are in rgb. I understand that the layer can contain multiple features with different colors and the code will pick the color from the first/last(?). That should be fine. I guess performance wise it should just take the color from the first feature. 

 

Would it be possible to modify this to read the features color and set it as the layers color? 

 

 

[ronjonp]

11 hours ago, edal said:

@ronjonp Thanks alot for the quick reply.  

 

The colorconversion part is correct. Problem is that the layers have a specified color, while the layers features have a specified rbg-color that is not by layer. I wasn't very specific when bringing this up, so i'll try to specify.

 

So the goal is to get the color from the features of a layer and then set the layers color to the color fetched from a feature. 

In my example the layers color is "white", but it contains features colored as eg: 209,217,174.

I would like the layers color to be 209,217,174.

 

From earlier in this thread this was posted: 

 

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

 

The above code seems to have the functionality i'm looking for, except that it doesn't play well when the features colors are in rgb. I understand that the layer can contain multiple features with different colors and the code will pick the color from the first/last(?). That should be fine. I guess performance wise it should just take the color from the first feature. 

 

Would it be possible to modify this to read the features color and set it as the layers color? 

 

 

Give this a try:

(defun c:c2l (/ ad b l ln)
  ;; RJP » 2023-10-02
  (setq ad (vla-get-activedocument (vlax-get-acad-object)))
  (vlax-for x (vla-get-layers ad) (setq l (cons (vla-get-name x) l)))
  (vlax-for a (vla-get-blocks ad)
    (vlax-for b	a
      (if (vl-position (setq ln (vla-get-layer b)) l)
	(progn (entmod (append (entget (tblobjname "layer" ln))
			       (vl-remove-if-not
				 '(lambda (x) (member (car x) '(62 420 430)))
				 (entget (vlax-vla-object->ename b))
			       )
		       )
	       )
	       (setq l (vl-remove ln l))
	)
      )
      (vl-catch-all-apply 'vla-put-color (list b 256))
    )
  )
  (princ)
)

 

[edal]

It works perfectly. Thanks alot!  

 

Now if you got any idea how to automatically convert pantone colors into rbg, i'm all ears.  

[ronjonp]

2 hours ago, edal said:

It works perfectly. Thanks alot!  

 

Now if you got any idea how to automatically convert pantone colors into rbg, i'm all ears.  

I think if you remove the 430 out of this list you should be good to go.

'(62 420 430)

 

Edited October 2, 2023 by ronjonp