Not able to filter the circle

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)

)

You trying to do this with LISP, VBA, Script, Macro?

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

(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.

Moving this to LISP forum.

Please place your code in between the code tags (#).

CODE POSTING GUIDE LINES

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

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

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!

(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)
)

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)
)

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.

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.

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!

as I still want it to be *right*.

.................

LoL

.................

What's so funny *this time*, haas...?

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)
)

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)
)