Routine to Select Circles by Radius or Diameter

[troggarf]

We have received a few drawings from another contractor and they exploded the whole drawing before sending it to us (thanks).

There are a bunch of circles with inner concentric circles that are making the test plots too dark for those symbols.

There are hundreds of these exploded symbols in a single drawing. And the drafters would like to delete the inner circles.

I have shown the guys QSELECT and yet that seems to be too difficult for them (too many options for them). And I have done a quick google search and haven't found any existing routines.

Does anyone have a routine that will select all circles of a user specific radius or diameter?

 

Thanks

~Greg

[Tharwat]

This should select circles with Diameter value 100.

 

(sssetfirst nil (ssget "_X" (list '(0 . "CIRCLE") (cons 40 100.))))

[jdiala]

Filter out the layer name also just in case you have other circles that you don't want to delete.

 

(defun C:delcir (/ l e ss r)
(if
 (and
   (setq e (car (entsel))
         l (cdr (assoc 8 (entget e)))
         r  (cdr (assoc 40(entget e)))
   )
   (setq ss (ssget "_X" (list (cons 0  "CIRCLE") (cons 8 l) (cons 40 r))))
 )
 (command "_.erase" ss "")
)
)

[troggarf]

Thank you both for your replies.

 

jdiala - this will work great for their needs.

 

Much appreciated

~Greg

[jdiala]

Your welcome

[Lee Mac]

(if
 (and
   (setq e (car (entsel))
         l (cdr (assoc 8 (entget e)))
         r  (cdr (assoc 40(entget e)))
   )
   

 

Be aware that this will error if the user fails to select an object

[Tharwat]

I hope that any of the selected circles won't be laying on a locked layer .

[Lee Mac]

Here's another option:

(defun c:cdel ( / e i s )
   (if
       (and
           (setq e (car (entsel "\nSelect the outermost circle: ")))
           (= "CIRCLE" (cdr (assoc 0 (setq e (entget e)))))
       )
       (if
           (setq s
               (ssget "_X"
                   (list
                      '(00 . "CIRCLE")
                      '(-4 . "<")
                       (assoc 040 e)
                       (assoc 008 e)
                       (assoc 410 e)
                   )
               )
           )
           (repeat (setq i (sslength s))
               (entdel (ssname s (setq i (1- i))))
           )
           (princ "\nNo smaller circles found.")
       )
   )
   (princ)
)

[jdiala]

Be aware that this will error if the user fails to select an object

 

Yes, I know. Don't wanna make the code any longer and use a condition function to test for e as this code will be probably use once and will be discarded.

 

You once said this and it's nailed on my head. "Account for every possibilities."

 

Thank you Lee for all your help in the past and future to come..

[Tharwat]

This is how I would go for it .

 

(defun c:DelCir (/ s ss e i)
 (if (and (progn (princ "\n Select outside Circle to delete smaller")
            (setq s (ssget "_+.:S:E" '((0 . "CIRCLE"))))
            )
          (setq ss (ssget "_X" (list '(0 . "CIRCLE") '(-4 . "<") (assoc 40 (setq e (entget (ssname s 0)))) (assoc 410 e))))
          )
   (repeat (setq i (sslength ss))
     (vl-catch-all-apply 'entdel (list (ssname ss (setq i (1- i)))))
     )
   )
 (princ)
 )
(vl-load-com)

[Lee Mac]

This is how I would go for it .

 

Why the use of vl-catch-all-apply?

[Tharwat]

Why the use of vl-catch-all-apply?

To pass over the locked layers .

[Lee Mac]

To pass over the locked layers .

 

Have you tried to entdel an entity on a locked layer?

Does it result in an error?

[Tharwat]

Oh , It doesn't throw any error but it only keep circles on locked layers highlighted . nothing's more .

[Lee Mac]

Oh , It doesn't throw any error but it only keep circles on locked layers highlighted . nothing's more .

 

The point I was making is that since entdel will never return an exception when the entity argument cannot be erased, the vl-catch-all-apply statement in your code is redundant.

Edited September 5, 2013 by Lee Mac

[jdiala]

How about this. It only delete circle/s inside of a circle as long as they have a common center point.

 

;;; jdiala 09-15-13 ;;;
(defun C:delcir (/ e l ss sss i x s1 s2)
(defun LM:Unique ( l ) ;;;Lee Mac;;;
   (if l (cons (car l) (LM:Unique (vl-remove (car l) (cdr l)))))
)
(if
 (and
   (setq e  (car (entsel))
         l  (cdr (assoc 8 (entget e)))
         ss (ssget "_X" (list (cons 0 "CIRCLE") (cons 8 l)))
   )
   (= "CIRCLE" (cdr (assoc 0 (entget e))))
 )

 
 (foreach x
   (LM:Unique
     (repeat 
       (setq i (sslength ss))
         (setq x (cons (cdr (assoc 10 (entget (ssname ss (setq i (1- i)))))) x))
     )
   )
  (setq sss (ssget "_X" (list (cons 0 "CIRCLE") (cons 8 l) (cons 10 x))))

  (while (> (sslength sss) 1)
    (if 
      (< 
        (cdr (assoc 40 (entget (setq s1 (ssname sss 0)))))
        (cdr (assoc 40 (entget (setq s2 (ssname sss 1)))))
     )
     (progn (ssdel s1 sss)(entdel s1)) 
     (progn (ssdel s2 sss)(entdel s2))
    )
)
) 
(princ)
)
)

[Lee Mac]

It only delete circle/s inside of a circle as long as they have a common center point.

 

Nice idea jdiala

 

Here is another possible way to write it, to avoid repeated selection set retrieval:

([color=BLUE]defun[/color] c:delcir ( [color=BLUE]/[/color] e i l s )
   ([color=BLUE]if[/color]
       ([color=BLUE]and[/color]
           ([color=BLUE]setq[/color] e ([color=BLUE]car[/color] ([color=BLUE]entsel[/color] [color=MAROON]"\nSelect Circle: "[/color])))
           ([color=BLUE]=[/color] [color=MAROON]"CIRCLE"[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 ([color=BLUE]setq[/color] e ([color=BLUE]entget[/color] e)))))
       )
       ([color=BLUE]foreach[/color] a
           (LM:groupbyfunction
               ([color=BLUE]repeat[/color]
                   ([color=BLUE]setq[/color] i
                       ([color=BLUE]sslength[/color]
                           ([color=BLUE]setq[/color] s
                               ([color=BLUE]ssget[/color] [color=MAROON]"_X"[/color]
                                   ([color=BLUE]list[/color] '(0 . [color=MAROON]"CIRCLE"[/color]) ([color=BLUE]assoc[/color] 8 e) ([color=BLUE]assoc[/color] 410 e))
                               )
                           )
                       )
                   )
                   ([color=BLUE]setq[/color] e ([color=BLUE]entget[/color] ([color=BLUE]ssname[/color] s ([color=BLUE]setq[/color] i ([color=BLUE]1-[/color] i))))
                         l ([color=BLUE]cons[/color] ([color=BLUE]list[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 10 e)) ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 40 e)) ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] -1 e))) l)
                   )
               )
               ([color=BLUE]lambda[/color] ( a b ) ([color=BLUE]equal[/color] ([color=BLUE]car[/color] a) ([color=BLUE]car[/color] b) 1e-)
           )
           ([color=BLUE]foreach[/color] b ([color=BLUE]cdr[/color] ([color=BLUE]vl-sort[/color] a '([color=BLUE]lambda[/color] ( a b ) ([color=BLUE]>[/color] ([color=BLUE]cadr[/color] a) ([color=BLUE]cadr[/color] b)))))
               ([color=BLUE]entdel[/color] ([color=BLUE]last[/color] b))
           )
       )
   )
   ([color=BLUE]princ[/color])
)

[color=GREEN];; Group By Function  -  Lee Mac[/color]
[color=GREEN];; Groups items considered equal by a given predicate function[/color]

([color=BLUE]defun[/color] LM:GroupByFunction ( lst fun [color=BLUE]/[/color] tmp1 tmp2 x1 )
   ([color=BLUE]if[/color] ([color=BLUE]setq[/color] x1 ([color=BLUE]car[/color] lst))
       ([color=BLUE]progn[/color]
           ([color=BLUE]foreach[/color] x2 ([color=BLUE]cdr[/color] lst)
               ([color=BLUE]if[/color] (fun x1 x2)
                   ([color=BLUE]setq[/color] tmp1 ([color=BLUE]cons[/color] x2 tmp1))
                   ([color=BLUE]setq[/color] tmp2 ([color=BLUE]cons[/color] x2 tmp2))
               )
           )
           ([color=BLUE]cons[/color] ([color=BLUE]cons[/color] x1 ([color=BLUE]reverse[/color] tmp1)) (LM:GroupByFunction ([color=BLUE]reverse[/color] tmp2) fun))
       )
   )
)
([color=BLUE]princ[/color])

[jdiala]

Nice code Lee.

 

BTW. That is 1e-8?

 

(lambda ( a b ) (equal (car a) (car b) [color="#ff8c00"]1e-8[/color]))

[Lee Mac]

Nice code Lee.

 

Cheers jdiala

 

BTW. That is 1e-8?

 

(lambda ( a b ) (equal (car a) (car b) [color=#ff8c00]1e-8[/color]))

 

Yes; 1e-8 = 1x10^-8 = 0.00000001

[jdiala]

ok. Thanks!