Change pastel colors to alternative colors by layer & elements & blocks

Hello! It's my first post. Here's my history with LISP. I've been using it for 2 days at work and so far I've been hacking and slashing trying to get a functioning LISP routine for Autocad 2008.

Here's my problem:

I have a series of 518 drawings. I'll be using scriptpro to run through them all and apply a LISP routine to do the following:

Loop through all of the layers in the drawing, and if they are yellow, cyan or magenta, change them to green, blue and red respectively. I also need it to run through any and all elements in the drawing to do the same thing and also to (command "burst") all blocks to apply the same color change to them. Make sense?

I have this code for bursting the blocks:

(defun c:bust ()

;(setvar "qaflags" 1)

(setq AllBlocks (ssget "X" (list (cons 0 "INSERT"))))

(while (/= AllBlocks nil)

(progn

(sssetfirst nil AllBlocks)

(c:burst)

(setq AllBlocks (ssget "X" (list (cons 0 "INSERT"))))

(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))

(vla-SendCommand doc (chr 27))

);progn

);while

(princ)

);defun

And I have this code (only works for one color, not all 3) for changing the elements in the drawing (only works in either paper or modelspace, not both which I need it to do):

(defun c:pastel2 ()

(setq ylo (ssget "X" ' ((62 . 2))))

(while (/= ylo nil)

(progn

(command "_.change" ylo "" "p" "color" "green" "")

(setq ylo (ssget "X" ' ((62 . 2))))

);progn

);while

(setq cya (ssget "X" ' ((62 . 4))))

(while (/= cya nil)

(progn

(command "_.change" cya "" "p" "color" "blue" "")

(setq cya (ssget "X" ' ((62 . 4))))

);progn

);while

(setq mag (ssget "X" ' ((62 . 6))))

(while (/= mag nil)

(progn

(command "_.change" mag "" "p" "color" "red" "")

(setq mag (ssget "X" ' ((62 . 6))))

);progn

);while

(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))

(vla-SendCommand doc (chr 27))

(princ)

);defun

Anyone want to help me out? It would be much appreciated.

This will affect any objects with Colours set other than ByLayer:

(defun c:Pastel2 nil
 (mapcar
   (function
     (lambda ( oc nc )
       (if (setq ss (ssget "_X" (list (cons 62 oc))))
         (
           (lambda ( x )
             (while (setq e (ssname ss (setq x (1+ x))))
               (ColourChange e nc)
             )
           )
           -1
         )
       )
     )
   )
   '(2 4 6)
   '(3 5 1)
 )

 (princ)
)

(defun ColourChange ( ent col / el )
 ;; © Lee Mac 2010
 (entupd
   (cdr
     (assoc -1
       (entmod
         (if (assoc 62 (setq el (entget ent)))
           (subst
             (cons 62 col) (assoc 62 el) el
           )
           (append el (list (cons 62 col)))
         )
       )
     )
   )
 )
)

Thanks for the code Lee, but I need to affect colors that are ByLayer as well.

Thanks for the code Lee, but I need to affect colors that are ByLayer as well.

This will take a little more code - I'll post an example

Try something like this:

(defun c:Pastel2 ( / def l )
 ;; © Lee Mac 2010

 (while (setq def (tblnext "LAYER" (not def)))
   (setq l
     (cons
       (cons (abs (cdr (assoc 62 def))) (cdr (assoc 2 def))) l
     )
   )
 )
 
 (mapcar
   (function
     (lambda ( oc nc / a )
       (if (setq ss
             (ssget "_X"
               (if (setq a (LM:mAssoc oc l))
                 (list
                   (cons -4 "<OR")
                     (cons 62 oc)
                     (cons 8 (LM:lst->str (mapcar 'cdr a) ","))
                   (cons -4 "OR>")
                 )
                 (list (cons 62 oc))
               )
             )
           )
         (
           (lambda ( x )
             (while (setq e (ssname ss (setq x (1+ x))))
               (LM:ColourChange e nc)
             )
           )
           -1
         )
       )
     )
   )
   '(2 4 6)
   '(3 5 1)
 )

 (princ)
)

(defun LM:ColourChange ( ent col / el )
 ;; © Lee Mac 2010
 (entupd
   (cdr
     (assoc -1
       (entmod
         (if (assoc 62 (setq el (entget ent)))
           (subst
             (cons 62 col) (assoc 62 el) el
           )
           (append el (list (cons 62 col)))
         )
       )
     )
   )
 )
)

(defun LM:lst->str ( lst del )
 ;; © Lee Mac 2010
 (if (cdr lst)
   (strcat (car lst) del (LM:lst->str (cdr lst) del))
   (car lst)
 )
)

(defun LM:mAssoc ( x lst )
 ;; © Lee Mac 2010
 (vl-remove-if-not
   (function
     (lambda ( pair ) (= x (car pair)))
   )
   lst
 )
)

It won't change Layer Colours, but rather set individual colours, but I wasn't sure of the intention.

Lee, that was great!

Yeah I would have liked to change the layer colors in the layer properties manager but this will work too.

Know any quick code to bust all of the blocks in both model and paper space as well?

This code currently only works in one or the other.

(defun c:bust ()
;(setvar "qaflags" 1)
(setq AllBlocks (ssget "X" (list (cons 0 "INSERT"))))
(while (/= AllBlocks nil)
(progn
(sssetfirst nil AllBlocks)
(c:burst)
(setq AllBlocks (ssget "X" (list (cons 0 "INSERT"))))
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
(vla-SendCommand doc (chr 27))
);progn
);while
(princ)
);defun

Why on earth would you want to Burst/Explode all of your blocks?

Yeah I would have liked to change the layer colors in the layer properties manager but this will work too.

I thought so:

(defun c:Pastel3 ( / col def a )
 ;; © Lee Mac 2010

 (setq col '((2 . 3) (4 . 5) (6 . 1)))

 (while (setq def (tblnext "LAYER" (not def)))
   (if (setq a (assoc (abs (cdr (assoc 62 def))) col))
     (LM:ColourChange (tblobjname "LAYER" (cdr (assoc 2 def))) (cdr a))
   )
 )

 (mapcar
   (function
     (lambda ( entry / ss )
       (if (setq ss (ssget "_X" (list (cons 62 (car entry)))))
         (
           (lambda ( x / e )
             (while (setq e (ssname ss (setq x (1+ x))))
               (LM:ColourChange e (cdr entry))
             )
           )
           -1
         )
       )
     )
   )
   col
 )

 (princ)
)


(defun LM:ColourChange ( ent col / el )
 ;; © Lee Mac 2010
 (entupd
   (cdr
     (assoc -1
       (entmod
         (if (assoc 62 (setq el (entget ent)))
           (subst
             (cons 62 col) (assoc 62 el) el
           )
           (append el (list (cons 62 col)))
         )
       )
     )
   )
 )
)

alanjt:

These drawings are done with the actual drafting process and are going straight to operators for printing. I know it's not the prettiest solution but I was looking to burst them all to change them to individual entities to change the colors in the simplest form. I just didn't have the LISP know-how to do that ByBlock.

Lee, coming back with an error that says:

Command: pastel3

; error: no function definition: COLOURCHANGE

I thought so:

 

(defun c:Pastel3 ( / col def a )
 ;; © Lee Mac 2010

 (setq col '((2 . 3) (4 . 5) (6 . 1)))

 (while (setq def (tblnext "LAYER" (not def)))
   (if (setq a (assoc (abs (cdr (assoc 62 def))) col))
     (LM:ColourChange (tblobjname "LAYER" (cdr (assoc 2 def))) (cdr a))
   )
 )

 (mapcar
   (function
     (lambda ( entry )
       (if (setq ss (ssget "_X" (list (cons 62 (car entry)))))
         (
           (lambda ( x )
             (while (setq e (ssname ss (setq x (1+ x))))
               (ColourChange e (cdr entry))
             )
           )
           -1
         )
       )
     )
   )
   col
 )

 (princ)
)


(defun LM:ColourChange ( ent col / el )
 ;; © Lee Mac 2010
 (entupd
   (cdr
     (assoc -1
       (entmod
         (if (assoc 62 (setq el (entget ent)))
           (subst
             (cons 62 col) (assoc 62 el) el
           )
           (append el (list (cons 62 col)))
         )
       )
     )
   )
 )
)

Its these small code boxes - you can't spot the mistakes...

You may have figured it out, but I renamed the function to keep in line with my standards and forgot to rename it in the main function.

Code updated.

Lee, it works fantastically! Thanks so much for your help.

One thing I noticed on a couple of drawings I have though is that I'm getting an error that says:

; error: bad argument type: lentityp nil

Any ideas what that is? Like I said, on some dwgs it's fine. Others I get the error.

I'm not sure why you would be receiving the error, but in any case, I have just tidied the code up some more, so perhaps this will solve the issue.

Perhaps load the code from the VLIDE (go to File > New File) and mark 'Break on Error' in the Debug menu before running it. Then Run the code on a troublesome drawing and then in the VLIDE click on 'Go to Last Break Source' and it will highlight the troublesome line of code.