求助:同心圆删除大圆只保留最小的一个

ymcui

如题                     

Andyhon

一个想法:

取得圆选集
(ssget '((0 . "CIRCLE")))

依次取出圆
半径至圆周 以 'F 滤取圆选集
若大于1 删除自身

xyp1964

2. ;; 同心圆留小
   
3. ;; 需要e派工具箱(XCAD)的支持：[url]http://yunpan.cn/QXQKsW9gAPmpF[/url](defun c:tt ()
   
4.   (xyp-CMDLA0)
   
5.   (setq i -1
   
6.         lst-del '()
   
7.         lst-save '()
   
8.   )
   
9.   (if (setq ss (ssget '((0 . "CIRCLE"))))
   
10.     (while (setq s1 (ssname ss (setq i (1+ i))))
    
11.       (if (and (not (member s1 lst-del)) (not (member s1 lst-save)))
    
12.         (if (setq ss1 (ssget "X" (list '(0 . "CIRCLE") (cons 10 (xyp-DXF 10 s1)))))
    
13.           (setq lst1 (xyp-ss2list ss1)
    
14.                 lst1 (mapcar '(lambda (x) (list (xyp-DXF 40 x) x)) lst1)
    
15.                 lst1 (vl-sort lst1 '(lambda (x y) (< (car x) (car y))))
    
16.                 lst1 (mapcar 'cadr lst1)
    
17.                 lst-save (cons (car lst1) lst-save)
    
18.                 lst-del (append (cdr lst1) lst-del)
    
19.           )
    
20.         )
    
21.       )
    
22.     )
    
23.   )
    
24.   (if lst-del
    
25.     (progn
    
26.       (setq ss (xyp-list2ss lst-del))
    
27.       (sssetfirst ss ss)
    
28.     )
    
29.   )
    
30.   (xyp-CMDLA1)
    
31. )
    

;; 同心圆留小<br /> ;; 需要e派工具箱(XCAD)的支持：[url]http://yunpan.cn/QXQKsW9gAPmpF[/url](defun c:tt ()<br />   (xyp-CMDLA0)<br />   (setq i -1<br />         lst-del '()<br />         lst-save '()<br />   )<br />   (if (setq ss (ssget '((0 . "CIRCLE"))))<br />     (while (setq s1 (ssname ss (setq i (1+ i))))<br />       (if (and (not (member s1 lst-del)) (not (member s1 lst-save)))<br />         (if (setq ss1 (ssget "X" (list '(0 . "CIRCLE") (cons 10 (xyp-DXF 10 s1)))))<br />           (setq lst1 (xyp-ss2list ss1)<br />                 lst1 (mapcar '(lambda (x) (list (xyp-DXF 40 x) x)) lst1)<br />                 lst1 (vl-sort lst1 '(lambda (x y) (< (car x) (car y))))<br />                 lst1 (mapcar 'cadr lst1)<br />                 lst-save (cons (car lst1) lst-save)<br />                 lst-del (append (cdr lst1) lst-del)<br />           )<br />         )<br />       )<br />     )<br />   )<br />   (if lst-del<br />     (progn<br />       (setq ss (xyp-list2ss lst-del))<br />       (sssetfirst ss ss)<br />     )<br />   )<br />   (xyp-CMDLA1)<br /> )<br />

ymcui

以下程序如何才能删除同心圆大的那个圆?

2. (setq ss(ssget '((0 . "circle"))))
   
3. (if ss(progn
   
4.   (setq m(sslength ss)n 0)
   
5.   (while(< n m)
   
6.     (setq e(ssname ss n)n(1+ n)l n
   
7.    p(assoc 10(entget e))
   
8.    P(vl-princ-to-string(list(nth 1 p)(nth 2 p)))
   
9.    a nil)
   
10.     (while(< l m)
    
11.       (setq f(ssname ss l)l(1+ l)
    
12.      p1(assoc 10(entget f))
    
13.      P1(vl-princ-to-string(list(nth 1 p1)(nth 2 p1))))
    
14.       (if(= p p1)
    
15.         (progn
    
16.    (ssdel f ss)(entdel f)
    
17.    (setq l(1- l)m(1- m)a t))))
    
18.     (if a(progn
    
19.     (ssdel e ss)
    
20.     (entdel e)
    
21.     (setq n(1- n)m(1- m))))
    
22.     )
    
23.   )
    
24.   )
    

(setq ss(ssget '((0 . "circle"))))<br /> (if ss(progn<br />   (setq m(sslength ss)n 0)<br />   (while(< n m)<br />     (setq e(ssname ss n)n(1+ n)l n<br />    p(assoc 10(entget e))<br />    P(vl-princ-to-string(list(nth 1 p)(nth 2 p)))<br />    a nil)<br />     (while(< l m)<br />       (setq f(ssname ss l)l(1+ l)<br />      p1(assoc 10(entget f))<br />      P1(vl-princ-to-string(list(nth 1 p1)(nth 2 p1))))<br />       (if(= p p1)<br />         (progn<br />    (ssdel f ss)(entdel f)<br />    (setq l(1- l)m(1- m)a t))))<br />     (if a(progn<br />     (ssdel e ss)<br />     (entdel e)<br />     (setq n(1- n)m(1- m))))<br />     )<br />   )<br />   )<br />

ymcui

xyp1964 发表于 2014-2-22 13:42

错误: no function definition: XYP-CMDLA0
错误: no function definition: XYP-DXF