Change layercolors to associated entity colors

Change layercolors to associated entity colors

Anonymous
Not applicable
973 Views
10 Replies
Message 1 of 11

Change layercolors to associated entity colors

Anonymous
Not applicable

Hello!

 

I have several drawings with entities placed in differend layers. The layercolors are all white. All the entities have colors (so, not bylayer...). I want the different layercolors (white or whatever...) to change to the same color of each associated entity. So layer A is color white. The entity on layer A is red. I run a script/lisp and voila. Layer A is now color red. Entity on layer A stays red (and the color of course is now bylayer...).

Can someone help me?

 

Regards,

Luis

0 Likes
Accepted solutions (1)
974 Views
10 Replies
Replies (10)
Message 2 of 11

Lee_Mac
Advisor
Advisor

Quickly written, but should perform as required:

 

(defun c:laycolfix ( / doc lay lst lyn )
    (setq doc (vla-get-activedocument (vlax-get-acad-object))
          lay (vla-get-layers doc)
    )
    (vlax-for blk (vla-get-blocks doc)
        (if (= :vlax-false (vla-get-isxref blk))
            (vlax-for obj blk
                (if (not (member (vla-get-color obj) '(0 256)))
                    (progn
                        (if (not (member (setq lyn (vla-get-layer obj)) lst))
                            (progn
                                (vla-put-color (vla-item lay lyn)(pp (vla-get-color obj)))
                                (setq lst (cons lyn lst))
                            )
                        )
                        (if (vlax-write-enabled-p obj)
                            (vla-put-color obj acbylayer)
                        )
                    )
                )
            )
        )
    )
    (princ)
)
(vl-load-com) (princ)

 

0 Likes
Message 3 of 11

Lineabove
Collaborator
Collaborator

Hi Lee.

 

Question please.

When I run this lisp I get the following message...

 

Cannot invoke (command) from *error* without prior call to (*push-error-using-command*).
Converting (command) calls to (command-s) is recommended.

 

Mel

 

 

0 Likes
Message 4 of 11

Lee_Mac
Advisor
Advisor

Are you sure that error message stems from my code? Since my code does not define a local *error* function, nor does it make any call to the command function.

 

Lee

0 Likes
Message 5 of 11

Lineabove
Collaborator
Collaborator

Hi Lee,

 

Not so sure, however I have attached a very simple drawing that if I run your lisp on, I will receive that error message.

 

If it matters, I am using AutoCAD Architecture 2015.

 

 

 

Any comments would be appreciated.

 

 

0 Likes
Message 6 of 11

Anonymous
Not applicable

Hi Lee,

Sorry for the late respons. Thanks for your reply/solution! Again, much appreciated!
I tried your lisp and the following error apears in de screen after loading the it:
; error: no function definition: PP
I tried both in Autocad 2012 and 2015. See also the attachment example dwg


Thanks!

Regards,
Luis

0 Likes
Message 7 of 11

Lee_Mac
Advisor
Advisor
Accepted solution

Apologies, I had left a test function where it shouldn't be - please try the following:

 

(defun c:laycolfix ( / doc lay lst lyn )
    (setq doc (vla-get-activedocument (vlax-get-acad-object))
          lay (vla-get-layers doc)
    )
    (vlax-for blk (vla-get-blocks doc)
        (if (= :vlax-false (vla-get-isxref blk))
            (vlax-for obj blk
                (if (not (member (vla-get-color obj) '(0 256)))
                    (progn
                        (if (not (member (setq lyn (vla-get-layer obj)) lst))
                            (progn
                                (vla-put-color (vla-item lay lyn) (vla-get-color obj))
                                (setq lst (cons lyn lst))
                            )
                        )
                        (if (vlax-write-enabled-p obj)
                            (vla-put-color obj acbylayer)
                        )
                    )
                )
            )
        )
    )
    (princ)
)
(vl-load-com) (princ)

 

Message 8 of 11

Lineabove
Collaborator
Collaborator

Thank you Lee.

 

I appreciate your contribution to this newsgroup.

 

Works perfect.

 

0 Likes
Message 9 of 11

Lee_Mac
Advisor
Advisor

Excellent to hear - you're very welcome Lineabove Smiley Happy

0 Likes
Message 10 of 11

Anonymous
Not applicable

Thank you also Lee! Tried it first thing in the morning and, as mentioned before, it works! Smiley Happy

0 Likes
Message 11 of 11

Lee_Mac
Advisor
Advisor

Excellent to hear Peter - I hope it saves you some time.

 

Lee

0 Likes