Jump to content

Not able to filter the circle


andy_gs

Recommended Posts

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 by andy_gs
Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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 by Tharwat
Codes updated for a better way Enjoy
Link to comment
Share on other sites

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!

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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! :beer:

Link to comment
Share on other sites

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

 

:)

Link to comment
Share on other sites

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

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

Link to comment
Share on other sites

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...