BIGAL Posted June 20, 2017 Share Posted June 20, 2017 (edited) 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 Quote Link to comment Share on other sites More sharing options...
Jozef13 Posted June 20, 2017 Author Share Posted June 20, 2017 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 Quote Link to comment Share on other sites More sharing options...
ronjonp Posted June 20, 2017 Share Posted June 20, 2017 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. Quote Link to comment Share on other sites More sharing options...
tive29 Posted June 20, 2017 Share Posted June 20, 2017 It should do that already. I tested it a 2nd time. Did not work when the entity is in block. Quote Link to comment Share on other sites More sharing options...
ronjonp Posted June 20, 2017 Share Posted June 20, 2017 Give it a try now, I updated the code .. had one line in the wrong loop. Quote Link to comment Share on other sites More sharing options...
Jozef13 Posted June 20, 2017 Author Share Posted June 20, 2017 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. Quote Link to comment Share on other sites More sharing options...
Jozef13 Posted June 20, 2017 Author Share Posted June 20, 2017 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. Quote Link to comment Share on other sites More sharing options...
tive29 Posted June 21, 2017 Share Posted June 21, 2017 Give it a try now, I updated the code .. had one line in the wrong loop. Thank you ronjonp Quote Link to comment Share on other sites More sharing options...
ronjonp Posted June 21, 2017 Share Posted June 21, 2017 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) ) Quote Link to comment Share on other sites More sharing options...
ronjonp Posted June 21, 2017 Share Posted June 21, 2017 Thank you ronjonp You're welcome. Quote Link to comment Share on other sites More sharing options...
Jozef13 Posted June 30, 2017 Author Share Posted June 30, 2017 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. Quote Link to comment Share on other sites More sharing options...
ronjonp Posted June 30, 2017 Share Posted June 30, 2017 Add (vla-put-layer b n) after (vla-put-color lo c). Quote Link to comment Share on other sites More sharing options...
Jozef13 Posted July 1, 2017 Author Share Posted July 1, 2017 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? Quote Link to comment Share on other sites More sharing options...
ronjonp Posted July 1, 2017 Share Posted July 1, 2017 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. Quote Link to comment Share on other sites More sharing options...
edal Posted September 26, 2023 Share Posted September 26, 2023 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. Quote Link to comment Share on other sites More sharing options...
ronjonp Posted September 27, 2023 Share Posted September 27, 2023 @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) ) Quote Link to comment Share on other sites More sharing options...
edal Posted October 2, 2023 Share Posted October 2, 2023 @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? Quote Link to comment Share on other sites More sharing options...
ronjonp Posted October 2, 2023 Share Posted October 2, 2023 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) ) 1 Quote Link to comment Share on other sites More sharing options...
edal Posted October 2, 2023 Share Posted October 2, 2023 It works perfectly. Thanks alot! Now if you got any idea how to automatically convert pantone colors into rbg, i'm all ears. Quote Link to comment Share on other sites More sharing options...
ronjonp Posted October 2, 2023 Share Posted October 2, 2023 (edited) 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 1 Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.