troggarf Posted September 5, 2013 Share Posted September 5, 2013 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 Quote Link to comment Share on other sites More sharing options...
Tharwat Posted September 5, 2013 Share Posted September 5, 2013 This should select circles with Diameter value 100. (sssetfirst nil (ssget "_X" (list '(0 . "CIRCLE") (cons 40 100.)))) Quote Link to comment Share on other sites More sharing options...
jdiala Posted September 5, 2013 Share Posted September 5, 2013 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 "") ) ) Quote Link to comment Share on other sites More sharing options...
troggarf Posted September 5, 2013 Author Share Posted September 5, 2013 Thank you both for your replies. jdiala - this will work great for their needs. Much appreciated ~Greg Quote Link to comment Share on other sites More sharing options...
jdiala Posted September 5, 2013 Share Posted September 5, 2013 Your welcome Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted September 5, 2013 Share Posted September 5, 2013 (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 Quote Link to comment Share on other sites More sharing options...
Tharwat Posted September 5, 2013 Share Posted September 5, 2013 I hope that any of the selected circles won't be laying on a locked layer . Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted September 5, 2013 Share Posted September 5, 2013 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) ) Quote Link to comment Share on other sites More sharing options...
jdiala Posted September 5, 2013 Share Posted September 5, 2013 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.. Quote Link to comment Share on other sites More sharing options...
Tharwat Posted September 5, 2013 Share Posted September 5, 2013 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) Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted September 5, 2013 Share Posted September 5, 2013 This is how I would go for it . Why the use of vl-catch-all-apply? Quote Link to comment Share on other sites More sharing options...
Tharwat Posted September 5, 2013 Share Posted September 5, 2013 Why the use of vl-catch-all-apply? To pass over the locked layers . Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted September 5, 2013 Share Posted September 5, 2013 To pass over the locked layers . Have you tried to entdel an entity on a locked layer? Does it result in an error? Quote Link to comment Share on other sites More sharing options...
Tharwat Posted September 5, 2013 Share Posted September 5, 2013 Oh , It doesn't throw any error but it only keep circles on locked layers highlighted . nothing's more . Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted September 5, 2013 Share Posted September 5, 2013 (edited) 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 Quote Link to comment Share on other sites More sharing options...
jdiala Posted September 5, 2013 Share Posted September 5, 2013 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) ) ) Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted September 5, 2013 Share Posted September 5, 2013 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]) Quote Link to comment Share on other sites More sharing options...
jdiala Posted September 5, 2013 Share Posted September 5, 2013 Nice code Lee. BTW. That is 1e-8? (lambda ( a b ) (equal (car a) (car b) [color="#ff8c00"]1e-8[/color])) Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted September 5, 2013 Share Posted September 5, 2013 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 Quote Link to comment Share on other sites More sharing options...
jdiala Posted September 5, 2013 Share Posted September 5, 2013 ok. Thanks! 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.