andy_gs Posted June 24, 2011 Share Posted June 24, 2011 (edited) Hello Guys, I am not much familiar with if and cond fun. I am trying to write simple routine which will filter all the circles under 1 inch and change them to different layer. if no circles under 1 inch alert a box. it;s working partially. Thanks in advance. Sorry here is the code.. (DEFUN C:KK() (setq md(ssget "X" '((0 . "CIRCLE") (-4 . " (IF (= MD NIL) (alert "NO Circles Under 1In Rad")) (IF ( (COMMAND "CHANGE" "MD" "" "p" "LA" "0" "C" "3" "")) ) (command "qsave" "" "") (princ) ) Edited June 27, 2011 by andy_gs Quote Link to comment Share on other sites More sharing options...
SLW210 Posted June 24, 2011 Share Posted June 24, 2011 You trying to do this with LISP, VBA, Script, Macro? Quote Link to comment Share on other sites More sharing options...
andy_gs Posted June 27, 2011 Author Share Posted June 27, 2011 I am trying to do this in lisp, Here is the code,2nd condition not working (DEFUN C:KK() (setq md(ssget "X" '((0 . "CIRCLE") (-4 . " (IF (= MD NIL) (alert "NO Circles Under 1In Rad")) (IF ( (COMMAND "CHANGE" "MD" "" "p" "LA" "0" "C" "3" "")) ) (command "qsave" "" "") (princ) ) Thanks Quote Link to comment Share on other sites More sharing options...
BIGAL Posted June 28, 2011 Share Posted June 28, 2011 (COMMAND "CHANGE" "MD" "" "p" "LA" "0" "C" "3" "")) "MD" maybe MD also ".change" not tested! maybe entmod is better way, look up help has exactly layer change as example. Quote Link to comment Share on other sites More sharing options...
SLW210 Posted June 28, 2011 Share Posted June 28, 2011 Moving this to LISP forum. Please place your code in between the code tags (#). CODE POSTING GUIDE LINES Quote Link to comment Share on other sites More sharing options...
David Bethel Posted June 28, 2011 Share Posted June 28, 2011 Maybe like this: [b][color=BLACK]([/color][/b]defun c:kk [b][color=FUCHSIA]([/color][/b]/ md[b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]if [b][color=NAVY]([/color][/b]setq md [b][color=MAROON]([/color][/b]ssget [color=#2f4f4f]"X"[/color] '[b][color=GREEN]([/color][/b][b][color=BLUE]([/color][/b]0 . [color=#2f4f4f]"CIRCLE"[/color][b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]-4 . [color=#2f4f4f]"<"[/color][b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]40 . 1.0[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b] [b][color=NAVY]([/color][/b]command [color=#2f4f4f]"_.CHANGE"[/color] md [color=#2f4f4f]""[/color] [color=#2f4f4f]"_P"[/color] [color=#2f4f4f]"_LA"[/color] [color=#2f4f4f]"0"[/color] [color=#2f4f4f]"_C"[/color] [color=#2f4f4f]"3"[/color] [color=#2f4f4f]""[/color] [color=#2f4f4f]"_.QSAVE"[/color] [color=#2f4f4f]""[/color] [color=#2f4f4f]""[/color][b][color=NAVY])[/color][/b] [b][color=NAVY]([/color][/b]alert [color=#2f4f4f]"No Circles Found With Radius Less Than 1"[/color][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]princ[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b] A couple things can get you with this scenario: It will not work on circles that are not in the current UCS. It will crash if all circle under 1" radius have been modified already. QSAVE does not need the extra Enter inputs. -David Quote Link to comment Share on other sites More sharing options...
Tharwat Posted June 28, 2011 Share Posted June 28, 2011 (edited) My way .. (defun c:test (/ ss ss1 j e ent NewSS) ;; Tharwat 28. 06. 2011 (if (setq ss (ssget "_x" '((0 . "CIRCLE"))) ss1 (ssadd) ) (repeat (setq j (sslength ss)) (setq e (ssname ss (setq j (1- j)))) (setq vl (vlax-ename->vla-object e)) (if (< (cdr (assoc 40 (setq ent (entget e)))) 1.0) (progn (setq NewSS (ssadd e ss1)) (vla-put-layer vl "0") (vla-put-color vl 3) ) (princ) ) ) (princ) ) (if (not NewSS) (alert " No Circles Found ") (princ (strcat "\n" "Number of changed circle(s) : " (itoa (sslength NewSS)) ) ) ) (princ) ) Tharwat Edited June 28, 2011 by Tharwat Codes updated for a better way Enjoy Quote Link to comment Share on other sites More sharing options...
BlackBox Posted June 28, 2011 Share Posted June 28, 2011 Here's another couple of options: This adaptation using only AutoLISP (entmod): (defun c:KK (/ ss) (if (setq ss (ssget "_x" '((0 . "CIRCLE") (-4 . "<") (40 . 1.0)))) (function (lambda (i / e ed c) (while (setq e (ssname ss (setq i (1+ i)))) (setq ed (entget e)) (setq ed (subst '(8 . "0") (assoc 8 ed) ed)) (if (setq c (assoc 62 ed)) (setq ed (subst '(62 . 3) c ed)) (setq ed (cons '(62 . 3) ed))) (entmod ed) (entupd e))) -1) (prompt "\n** No circles with radius less than 1.0 ** ")) (princ)) This adaptation using only Visual LISP (ActiveX): (defun c:KK (/ *error* ss activeDoc) (vl-load-com) (defun *error* (msg) (vla-endundomark activeDoc) (cond ((not msg)) ; Normal exit ((member msg '("Function cancelled" "quit / exit abort"))) ; <esc> or (quit) ((princ (strcat "\n** Error: " msg " ** ")))) ; Fatal error, display it (princ)) (if (setq ss (ssget "x" '((0 . "CIRCLE") (-4 . "<") (40 . 1.0)))) (progn (vla-startundomark (setq activeDoc (vla-get-activedocument (vlax-get-acad-object)))) (vlax-for x (setq ss (vla-get-activeselectionset activeDoc)) (vla-put-color x acgreen) (vla-put-layer x "0")) (vla-delete ss) [color=green] ;;(vla-save activeDoc) ; <- Uncomment to save [/color] (vla-endundomark activeDoc)) (prompt "\n** No circles found with radius less than 1 ** ")) (princ)) Note - I'm not a fan of including "save" functionality to operations that modify entities, that way the user is forced to knowingly initiate the save, but I included this functionality (commented out) in the above example for your use. Enjoy! Quote Link to comment Share on other sites More sharing options...
alanjt Posted June 28, 2011 Share Posted June 28, 2011 (defun c:Test (/ ss i) (if (setq ss (ssget "_:L" '((0 . "CIRCLE") (-4 . "<") (40 . 1.)))) (repeat (setq i (sslength ss)) (entupd (cdr (assoc -1 (entmod (append (entget (ssname ss (setq i (1- i)))) '((8 . "0") (62 . 3))))) ) ) ) ) (princ) ) Quote Link to comment Share on other sites More sharing options...
alanjt Posted June 28, 2011 Share Posted June 28, 2011 Actually, you could even filter circles that have already been fixed... (defun c:Test (/ ss i) (if (setq ss (ssget "_:L" '((0 . "CIRCLE") (-4 . "<") (40 . 1.) (-4 . "<NOT") (-4 . "<AND") (8 . "0") (62 . 3) (-4 . "AND>") (-4 . "NOT>") ) ) ) (repeat (setq i (sslength ss)) (entupd (cdr (assoc -1 (entmod (append (entget (ssname ss (setq i (1- i)))) '((8 . "0") (62 . 3))))) ) ) ) ) (princ) ) Quote Link to comment Share on other sites More sharing options...
David Bethel Posted June 28, 2011 Share Posted June 28, 2011 Renderman, (setq ed (cons '(62 . 3) ed) This may work on an (entmod) call. It would cause a (entmake) call to fail Actually, you could even filter circles that have already been fixed... -David Alan, I like the filter. I don't know if I like having 2 (8 . "") values in a single entity definition. Quote Link to comment Share on other sites More sharing options...
alanjt Posted June 28, 2011 Share Posted June 28, 2011 Alan, I like the filter. I don't know if I like having 2 (8 . "") values in a single entity definition. Thanks, I figured, why select and edit something that's already how you want it. I'm lazy, so I make my code lazy too. One overrides the other. It's not as if you'll have two 8 definitions. It's something Lee and I discovered a while back. Does it work in older versions? I can only test in 2009 and 2011. Quote Link to comment Share on other sites More sharing options...
BlackBox Posted June 28, 2011 Share Posted June 28, 2011 Renderman, (setq ed (cons '(62 . 3) ed) This may work on an (entmod) call. It would cause a (entmake) call to fail Dually noted... I rarely do anything in 100% AutoLISP, this was merely an attempt to do something different than I am accustomed. So thank you, as I still want it to be *right*. Cheers! Quote Link to comment Share on other sites More sharing options...
alanjt Posted June 28, 2011 Share Posted June 28, 2011 as I still want it to be *right*.LoL................. Quote Link to comment Share on other sites More sharing options...
BlackBox Posted June 28, 2011 Share Posted June 28, 2011 LoL................. What's so funny *this time*, haas...? Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted June 28, 2011 Share Posted June 28, 2011 Nice code Alan I would be inclined to tweak it ever so slightly: (defun c:test ( / ss i ) (if (setq ss (ssget "_:L" '( (0 . "CIRCLE") (-4 . "<") (40 . 1.) (-4 . "<NOT") (-4 . "<AND") (8 . "0") (62 . 3) (-4 . "AND>") (-4 . "NOT>") ) ) ) (repeat (setq i (sslength ss)) (entmod (cons (cons -1 (ssname ss (setq i (1- i)))) '((8 . "0") (62 . 3)))) ) ) (princ) ) Quote Link to comment Share on other sites More sharing options...
alanjt Posted June 28, 2011 Share Posted June 28, 2011 What's so funny *this time*, haas...? Just that you always want to be *right*. Just read funny. Nice code Alan I would be inclined to tweak it ever so slightly: Ohhh, I completely forgot about the 'cheating' method. Nice one. Once slight addon, just to for completeness... (defun c:test (/ ss i) (if (setq ss (ssget "_:L" '((0 . "CIRCLE") (-4 . "<") (40 . 1.) (-4 . "<NOT") (-4 . "<AND") (8 . "0") (62 . 3) (-4 . "AND>") (-4 . "NOT>") ) ) ) (repeat (setq i (sslength ss)) (entupd (cdar (entmod (cons (cons -1 (ssname ss (setq i (1- i)))) '((8 . "0") (62 . 3)))))) ) ) (princ) ) 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.