Select red and move red?????

use CHT

 

Is there a quick way to make a lisp that will select everything in a drawing
that is red (be it forced to red or set to bylayer on a layer that is set to
red) and move it to a layer named LW-RED?

Thanks
Chris

 

Is there a quick way to make a lisp

No. But somebody may have taken the time to write such a routine. Getting
all of both kinds of "red" is not a trivial task, and without a whole lot of
programming, it's not going to get nested subentities, like lines within a
block.

You can use QSELECT and PROPERTIES to do most of this, but the same
disclaimers apply.

 

use CHT

Whatever it is, that's not an AutoCAD command.

 

can you not filter - color - red
pulldown req' layer done?
Seems a few less steps

 

If you don't mind an old vanilla lisp one.

Limited tested.

Code:

;;7/14/03 Bill Zondlo
;;Program to get list of all layers
;;and get selections of entities base on color
;;and change layer.
;;WARNING: Converts whole groups and blocks over to layer if on COLOR layer.

(defun Chge_clr_lay ()
(setq lt1 (list (tblnext "LAYER" T))
)
(while (setq l (tblnext "LAYER"))
(setq lt1 (cons l lt1)
lt2 (cons (cdr (assoc 2 l)) lt2)
)
)
(setq lt1 (reverse lt1)
lt2 (reverse lt2)
)
;---;
(if (null (tblsearch "layer" "LW-RED"))                          ;make clear layer if doesn't exist
(command "_.layer" "m" "LW-RED" "color" "1" "" "")
(command "_.layer" "s" "LW-RED" "")                          ;otherwise set to clear layer
)
;---;
(foreach n lt1
(if (= (cdr (assoc 62 n)) 1)
(progn
(setq ss1 (ssget "x" (list (cons -4  "<AND")(cons 8 (cdr (assoc 2 n)))(cons -4  "<OR")(cons 62  1)(cons 62  256)(cons -4 "OR>")(cons -4 "AND>")))
)
(setq ss2 (ssget "x" (list (cons 8  (cdr (assoc 2 n)))(cons 62 1)))
)
)
)                                                            ;end if
(if ss1
(command "chprop" ss1 "" "LA" "LW-RED" "")
)
(if ss2
(command "chprop" ss2 "" "LA" "LW-RED" "")
)
)                                                               ;end foreach
)                                                                 ;end defun.

Bill

 

That won't get the things that are red because their layer is red and
they're BYLAYER. It will only get the things with explicit red color
assigned.

 

Here's one that works on all entities, even those in blocks, including
attributes. You can use the function for any color/layer you want, jsut
change the calling command......

(defun c:col2lay ()
(color2layer 1 "LW-RED")
(princ)
)

(defun color2layer (color layer / atts doc lay lays)
(vl-load-com)
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vlax-for lay (vla-get-layers doc)
(if (and (= color (vla-get-color lay))
(not (vl-string-search "|" (vla-get-name lay)))
)
(setq lays (cons (vla-get-name lay) lays))
)
)
(vla-startundomark doc)
(setq lay (vla-add (vla-get-layers doc) layer))
(vla-put-color lay color)
(vlax-for blk (vla-get-blocks doc)
(vlax-for ent blk
(if (or (eq (vla-get-color ent) color)
(member (vla-get-layer ent) lays)
)
(vla-put-layer ent layer)
)
(if (and (vlax-property-available-p ent "hasattributes")
(vla-get-hasattributes ent)
(setq atts (vlax-invoke ent "getattributes"))
)
(progn
(foreach att atts
(if (or (eq (vla-get-color att) color)
(member (vla-get-layer att) lays)
)
(vla-put-layer att layer)
)
(vla-update att)
)
)
);

)
)
(vla-endundomark doc)
(princ)
)

 

And as soon as I posted this I realized that it would fall flat on it's face
if any layers are locked. Here's a fix for that:

(defun color2layer (color layer / atts doc lay lays lokt)
(vl-load-com)
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vlax-for lay (vla-get-layers doc)
(if (and (= color (vla-get-color lay))
(not (vl-string-search "|" (vla-get-name lay)))
)
(progn
(setq lays (cons (vla-get-name lay) lays))
(if (vla-get-lock lay)
(progn
(setq lokt (cons (vla-get-name lay) lokt))
(vla-put-lock lay :vlax-false)
)
)
)
)
)
(vla-startundomark doc)
(setq lay (vla-add (vla-get-layers doc) layer))
(vla-put-color lay color)
(vlax-for blk (vla-get-blocks doc)
(vlax-for ent blk
(if (or (eq (vla-get-color ent) color)
(member (vla-get-layer ent) lays)
)
(vla-put-layer ent layer)
)
(if (and (vlax-property-available-p ent "hasattributes")
(vla-get-hasattributes ent)
(setq atts (vlax-invoke ent "getattributes"))
)
(progn
(foreach att atts
(if (or (eq (vla-get-color att) color)
(member (vla-get-layer att) lays)
)
(vla-put-layer att layer)
)
(vla-update att)
)
)
);

)
)
(if lokt
(foreach lay lokt
(vla-put-lock (vla-item (vla-get-layers doc) lay) :vlax-true)
)
)
(vla-endundomark doc)
(princ)
)

 

Jeff that works great! What I wanted to add another color to look for?
Would I just add another line to the calling command? Like This:
(defun c:col2lay ()
(color2layer 1 "LW-RED")
(color2layer 2 "LW-Yellow")
(princ)

Sorry for my ignorance.
Thanks,
Chris

 

Yep, that's all there is to it. Glad you like it!

 

Yes - I had tried what I was thinking and it works like a CHAMP. Thank You
so much!
and Happy Holidays.

Chris

 

Jeff, Is there then a way to change all colors and objects to color bylayer?
If so, would it work within blocks too?

Thanks

 

Sure, using the same basic concept. Yes, it will work in blocks, too. I
believe that either I or another poster recently posted a routine to do just
this. If you want, you could borrow from this code to do what you
want.....Hint: bylayer is color 256..... Hint2: don't try to set a layer to
color bylayer......

 

*^%&^^%, OK. I posted that without checking. The lock/unlock/relock portion
didn't work correctly. Here's one I've tested.....sorry about that.

Code:

(defun color2layer (color layer / atts doc lay lays lokt)
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vlax-for lay (vla-get-layers doc)
(if (and (= color (vla-get-color lay))
(not (vl-string-search "|" (vla-get-name lay)))
)
(setq lays (cons (vla-get-name lay) lays))
)
(if (eq :vlax-true (vla-get-lock lay))
(progn
(setq lokt (cons (vla-get-name lay) lokt))
(vla-put-lock lay :vlax-false)
)
)
)
(vla-startundomark doc)
(setq lay (vla-add (vla-get-layers doc) layer))
(vla-put-color lay color)
(vlax-for blk (vla-get-blocks doc)
(vlax-for ent blk
(if (or (eq (vla-get-color ent) color)
(member (vla-get-layer ent) lays)
)
(vla-put-layer ent layer)
)
(if (and (vlax-property-available-p ent "hasattributes")
(vla-get-hasattributes ent)
(setq atts (vlax-invoke ent "getattributes"))
)
(progn
(foreach att atts
(if (or (eq (vla-get-color att) color)
(member (vla-get-layer att) lays)
)
(vla-put-layer att layer)
)
(vla-update att)
)
)
);

)
)
(if lokt
(foreach lay lokt
(vla-put-lock (vla-item (vla-get-layers doc) lay) :vlax-true)
)
)
(vla-endundomark doc)
(princ)
)

 

Thanks Jeff,

I think I'll be replacing my old program with this one.

Bill