[编程交流] 通过R选择圆的例程

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

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

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