Lisp to change object colour

Hi All,

Anyone know how to change all the objects to White colour except red colour object through lisp.

Thanks in advance.

Try the following :

(vl-load-com)

(defun c:test (/ *error* c_doc ss)

   (defun *error* ( msg ) 
       (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
       (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error : " msg " occurred.")))
       (princ)
   );_end_*error*_defun

   (setq c_doc (vla-get-activedocument (vlax-get-acad-object))
       ss (ssget "_X" '((67 . 0)))
   )
 
   (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
   (vla-startundomark c_doc)

 (vlax-for x (vla-get-activeselectionset c_doc)
   (if (and (vlax-property-available-p x 'color T) (/= (vlax-get x 'color) 1))
     (vlax-put x 'color 7)
   );end_if
 );end_for
 
 (if (= 8 (logand 8 (getvar 'UNDOCTL))) (vla-endundomark c_doc))
);end_defun

IMPORTANT NOTE: THIS CODE WILL CHANGE THE COLOR OF ALL MODELSPACE ENTITIES ONLY, AND WHERE THE ENTITY HAS A WRITEABLE COLOR PROPERTY. THIS INCLUDES ENTITIES ON LAYERS WHERE THE LAYER COLOUR IS RED, AND THE ENTITY COLOR IS SET TO BYLAYER.

IT DOES NOT CHANGE THE COLOR OF INDIVIDUAL ENTITIES WITHIN BLOCKS, ONLY THE COLOR OF THE BLOCK ITSELF.

Hi dlanorh,

Thanks for your quick reply.

Your code was worked perfectly.

Thank you so much.

Heres another vanilla:

(defun C:test ( / SS i )
 (if (setq SS (ssget "X" '((-4 . "<>")(62 . 1))))
   (repeat (setq i (sslength SS))
     (entmod (append (vl-remove-if ''((x)(member (car x) '(420 430))) (entget (ssname SS (setq i (1- i))))) '((62 . 7))))
   )
 )
 (princ)
)

Heres another vanilla:

(defun C:test ( / SS i )
 (if (setq SS (ssget "X" '((-4 . "<>")(62 . 1))))
   (repeat (setq i (sslength SS))
     (entmod (append (vl-remove-if ''((x)(member (car x) '(420 430))) (entget (ssname SS (setq i (1- i))))) '((62 . 7))))
   )
 )
 (princ)
)

is vl-remove-if vanilla? , mmm , just tasting it now ... mmm , no , it's

Forgive me butting in (Lisp noob), I'm probably way of course here but what is wrong with this, serious question! it works but probably misses some important detail and I'd like to know if I might be heading in the wrong direction with this, hence the "twit" unless you speak dutch "te wit" or "too white" translated.

(defun C:twit ()
 (command "chprop" (ssget "x" '((-4 . "<>") (62 . 1))) "" "c" "white" "")
)

(62 . 7) = white maybe?

also , ssget might return nil so :

 (if (setq ss (ssget ....)) (command .....)) 

not too good with ssgetfilters myself , not like the big guys anyway but I'm not sure about the "" so time to do a little brain update...

but just tried something like this to change all lines , who don't have color white (7) to red (1)

 (if (setq ss (ssget "x" '((0 . "LINE") (-4 . "<NOT") (62 . 7)(-4 . "NOT>"))))
   (command "._chprop" ss "" "c" "red" ""))

also , ssget might return nil so :

Is that something you normally consider, surely if it returns nil then nothing happens or are there cicumstances when this could cause errors.

PS I fixed the code above

Is that something you normally consider, surely if it returns nil then nothing happens or are there cicumstances when this could cause errors.

 

PS I fixed the code above

in programming lisp you always have to be prepared for 'de worst' , that no object is found to match your (ssget) filter. Someone can say yes on your question , or no , but also nothing ... and nothing can also be an answer...

Forgive me butting in (Lisp noob), I'm probably way of course here but what is wrong with this, serious question! it works but probably misses some important detail and I'd like to know if I might be heading in the wrong direction with this, hence the "twit" unless you speak dutch "te wit" or "too white" translated.

(defun C:twit ()
 (command "chprop" (ssget "x" '((-4 . "<>") (62 . 7))) "" "c" "white" "")
)

Absolutely nothing wrong with the code at all. I would probably change the "x" to "_x" to force the english version as insurance against potential problems in different languages.

"chprop" however, as i understand it, will only work on entities in the current space, whereas the vanilla/visual lisp versions aren't bound by this. If I remove the '((67 . 0)) [modelspace entities only] filter from my code it will process all entities on all tabs in paperspace.

is vl-remove-if vanilla? , mmm , just tasting it now ... mmm , no , it's

I remember once Marko_Ribar told(wrote) me that not all vl-* functions are from activex (somewhere here on the forum).

But I'm mistaken them just like you.. soo If I had to write that in vanilla for sure, I'd substitute:

(entmod (append (vl-remove-if ''((x)(member (car x) '(420 430))) (entget (ssname SS (setq i (1- i))))) '((62 . 7))))

with:

(entmod
 (append
   (apply 'append
     (mapcar 
       ''((x)
         (cond
           ( (member (car x) '(420 430)) ()) ; note, () = nil
           ( (list x) )
         )
       ) 
       (entget (ssname SS (setq i (1- i))))
     )
   ) 
   '((62 . 7))
 )
)

You're making me thirsty Grrr haha

Even though many cases your code can be shorter and cleaner using vl- functions , just using vanilla has it's advantages. Added a for example a core console option to my batch utility and this only works with vanilla lisp and also often vanilla is faster than some of the vl-functions

Even though many cases your code can be shorter and cleaner using vl- functions , just using vanilla has it's advantages. Added a for example a core console option to my batch utility and this only works with vanilla lisp and also often vanilla is faster than some of the vl-functions

Yea, its no secret that vanilla is faster.

Shorter - perhaps?

Cleaner? - my definition for cleaner is to structure the whole code into 'blocks', such as functions/subfunctions with a good formatting.

So when its time to maintain you just have to focus on the certain block of the code.

I admire your ideas(codes), although I have alot of other stuff to learn ATM but at first I'm trying to finish my architectural projects, DOH!

Yea, its no secret that vanilla is faster.

Shorter - perhaps?

Cleaner? - my definition for cleaner is to structure the whole code into 'blocks', such as functions/subfunctions with a good formatting.

So when its time to maintain you just have to focus on the certain block of the code.

 

I admire your ideas(codes), although I have alot of other stuff to learn ATM but at first I'm trying to finish my architectural projects, DOH!

We are way past the point you can learn anything new from me when I look at some your code this past year. Don't have enough time to get it through my thick skull any more haha. Also in the summer time I usually don't do as much coding so each winter(ish) time is a new startup for me. Good luck with your architectural project. Workday is done and now have to face the more grim task of having diner with oldest daughter & family ;-)

FWIW, here's another way to remove items from a list using Vanilla AutoLISP:

(defun remove ( x l )
   (apply 'append (subst nil (list x) (mapcar 'list l)))
)

FWIW, here's another way to remove items from a list using Vanilla AutoLISP:

(defun remove ( x l )
 (apply 'append (subst nil (list x) (mapcar 'list l)))
)

Nice one, Lee! It can substitute the vl-remove function.

We are way past the point you can learn anything new from me

I've got some stored stuff in my archive from your posted codes, that I still have to chew up.

when I look at some your code this past year. Don't have enough time to get it through my thick skull any more haha.

Nah, its just that my coding style is alot different from yours - I'm sure you'll get it when you start focus on the individual blocks of the code.

Good luck with your architectural project.

Thanks!

Workday is done and now have to face the more grim task of having diner with oldest daughter & family ;-)

Wish you have(had) a great time there!

FWIW, here's another way to remove items from a list using Vanilla AutoLISP:

(defun remove ( x l )
   (apply 'append (subst nil (list x) (mapcar 'list l)))
)

Nice Lee .. check this out with a list of 7200 items

REMOVE Benchmarking ..................Elapsed milliseconds / relative speed for 32768 iteration(s):

   (REMOVE 1 (QUOTE (1 1 1 3 4 5 6 11 1...).....1469 / 5.18 <fastest>
   (VL-REMOVE 1 L)..............................7610 / 1.00 <slowest>

Wow, that's quite surprising.

there's lots of still 'good old stuf' around http://autocad.xarch.at/lisp/goodies.html