deucer Posted July 21, 2010 Share Posted July 21, 2010 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. Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted July 21, 2010 Share Posted July 21, 2010 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))) ) ) ) ) ) ) Quote Link to comment Share on other sites More sharing options...
deucer Posted July 22, 2010 Author Share Posted July 22, 2010 Thanks for the code Lee, but I need to affect colors that are ByLayer as well. Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted July 22, 2010 Share Posted July 22, 2010 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 Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted July 22, 2010 Share Posted July 22, 2010 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. Quote Link to comment Share on other sites More sharing options...
deucer Posted July 22, 2010 Author Share Posted July 22, 2010 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 Quote Link to comment Share on other sites More sharing options...
alanjt Posted July 22, 2010 Share Posted July 22, 2010 Why on earth would you want to Burst/Explode all of your blocks? Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted July 22, 2010 Share Posted July 22, 2010 (edited) 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))) ) ) ) ) ) ) Edited July 23, 2010 by Lee Mac Quote Link to comment Share on other sites More sharing options...
deucer Posted July 22, 2010 Author Share Posted July 22, 2010 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. Quote Link to comment Share on other sites More sharing options...
deucer Posted July 22, 2010 Author Share Posted July 22, 2010 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))) ) ) ) ) ) ) Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted July 22, 2010 Share Posted July 22, 2010 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. Quote Link to comment Share on other sites More sharing options...
deucer Posted July 22, 2010 Author Share Posted July 22, 2010 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. Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted July 23, 2010 Share Posted July 23, 2010 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. 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.