如何在圆选择集中高效的分离出同心圆

qinleilei

大家好！
最近准备写一个程序，碰到了难点了，大致如下：
首先有一个选择集 (setq ss (ssget '( (0 . "CIRCLE") )) )
我需要把里面不是同心的圆放入到选择集SS1里面 ，自己想了个笨办法但是图元多了就容易卡死
求大家帮我优化一下，或者出个好的方案。谢谢了！

1. (defun c:tt ( )
   
2.   (setq ss (ssget '( (0 . "CIRCLE") )) )
   
3.   (setq LST_ENT '()
   
4.     I 0
   
5.   )
   
6.   (repeat (sslength SS)
   
7.     (setq LST_ENT (cons (assoc 10 (entget(ssname ss i))) LST_ENT)
   
8.       I        (1+ I)
   
9.     )
   
10.   )
    
11.   (setq LST_ENT(delsames LST_ENT  0.0001));不是同心圆的点表
    
12.   (setq i 0 )
    
13.   (setq ss1 (ssadd) );空选择集
    
14.   (repeat (length LST_ENT)
    
15.     (setq sso (ssget "p" (list '(0 . "CIRCLE") (cons 10 (cdr (nth i LST_ENT)))))
    
16.       ss1(ssadd (ssname sso 0) ss1)
    
17.       i   (1+ i)
    
18.     )
    
19.     (vl-cmdf "_.select" ss "")
    
20.   )
    
21. )
    
22. 
    
23. (defun delsames(l1 rcz / a l l2);;带容差去重(重复过的不出现)
    
24.   (while(setq a(car l1)l2(vl-remove-if'(lambda (x)(equal a x rcz))(cdr l1)))
    
25.     (if(=(1+(length l2))(length l1))(setq l(cons a l)))
    
26.     (setq l1 l2))
    
27.   (if(=(1+(length l2))(length l1))(setq l(cons a l)))
    
28.   (reverse l))

(defun c:tt ( )<br />   (setq ss (ssget '( (0 . "CIRCLE") )) )<br />   (setq LST_ENT '()<br />     I 0<br />   )<br />   (repeat (sslength SS)<br />     (setq LST_ENT (cons (assoc 10 (entget(ssname ss i))) LST_ENT)<br />       I        (1+ I)<br />     )<br />   )<br />   (setq LST_ENT(delsames LST_ENT  0.0001));不是同心圆的点表<br />   (setq i 0 )<br />   (setq ss1 (ssadd) );空选择集<br />   (repeat (length LST_ENT)<br />     (setq sso (ssget "p" (list '(0 . "CIRCLE") (cons 10 (cdr (nth i LST_ENT)))))<br />       ss1(ssadd (ssname sso 0) ss1)<br />       i   (1+ i)<br />     )<br />     (vl-cmdf "_.select" ss "")<br />   )<br /> )<br /> <br /> (defun delsames(l1 rcz / a l l2);;带容差去重(重复过的不出现)<br />   (while(setq a(car l1)l2(vl-remove-if'(lambda (x)(equal a x rcz))(cdr l1)))<br />     (if(=(1+(length l2))(length l1))(setq l(cons a l)))<br />     (setq l1 l2))<br />   (if(=(1+(length l2))(length l1))(setq l(cons a l)))<br />   (reverse l))

llsheng_73

1. (defun tt(n f / e p s i l)
   
2.   (if(setq i 0 f(if f'(1 1 1)'(1 1))s(ssget'((0 . "CIrcle"))))
   
3.     (progn
   
4.       (repeat(sslength s)
   
5.         (setq e(ssname s i)
   
6.               p(mapcar'(lambda(x)(rtos x 2 n))(mapcar'*(cdr(assoc 10(entget e)))f))
   
7.               l(cons(list p e)l)i(1+ i)))
   
8.       (mapcar'(lambda(x)(if(assoc(car x)(vl-remove x l))(setq s(ssdel(cadr x)s))))l)
   
9.      s)))

(defun tt(n f / e p s i l)<br />   (if(setq i 0 f(if f'(1 1 1)'(1 1))s(ssget'((0 . "CIrcle"))))<br />     (progn<br />       (repeat(sslength s)<br />         (setq e(ssname s i)<br />               p(mapcar'(lambda(x)(rtos x 2 n))(mapcar'*(cdr(assoc 10(entget e)))f))<br />               l(cons(list p e)l)i(1+ i)))<br />       (mapcar'(lambda(x)(if(assoc(car x)(vl-remove x l))(setq s(ssdel(cadr x)s))))l)<br />      s)))

(TT 3 T);;考虑圆心高程，用3位小数限定精度
(TT 5 nil);;忽略圆心高程，用5位小数限定精度

kozmosovia

你的同心圆圆心应该是嫩提前知道的，直接ssget时过滤10不等于该值就行了

自贡黄明儒

下面的代码我没有试过，你自己试一下

(defun c:w1 (/ E I L Le P SS)
  (setq ss (ssget '((0 . "CIRCLE"))))
  (repeat (setq i (sslength SS))
    (setq i (1- i))
    (setq e (ssname ss i))
    (setq P (cdr (assoc 10 (entget e))))
    (setq L (cons p L))
  )
  (repeat (setq i (sslength SS))
    (setq i (1- i))
    (setq e (ssname ss i))
    (setq P (cdr (assoc 10 (entget e))))
    (cond ((member P (member p L)) (setq Le (cons e Le))))
  )
  (if Le
    (mapcar '(lambda (x) (ssdel x ss)) Le)
  )
  ss
)

ll_j

自贡黄明儒 发表于 2016-7-18 08:49
下面的代码我没有试过，你自己试一下

(defun c:w1 (/ E I L P SS)

这段代码大体思路是对的，但结果可能不正确。
原因：因为浮点数的缘故，所以点表几乎没有相同的，即使就在一起的两个表，判断相等也可能不成立。
使用member可能不是好方法，建议使用distance（精度）来遍历，时间可能长一些，但是结果应该正确。

Andyhon

有个想法...
先将圆心转成点

排序法有很多,引用时得分析资料特性为依据

圆的分布,数量,密集度,非同心而又有交集...
皆为考量的因素

qinleilei

Andyhon 发表于 2016-7-18 12:20
有个想法...
先将圆心转成点

有点不明白的

qinleilei

自贡黄明儒 发表于 2016-7-18 08:49
下面的代码我没有试过，你自己试一下

(defun c:w1 (/ E I L P SS)

测试了一下黄工的代码，有问题

陨落

去除同心圆，那保留哪一个同心圆呢？
可以用vl-remove-if-not+vl-remove解决，带容差的比较用equal

qinleilei

陨落 发表于 2016-7-18 16:49
去除同心圆，那保留哪一个同心圆呢？
可以用vl-remove-if-not+vl-remove解决，带容差的比较用equal

vl-remove-if-not+vl-remove  这两个函数我不会用

qinleilei

自贡黄明儒 发表于 2016-7-18 08:49
下面的代码我没有试过，你自己试一下

(defun c:w1 (/ E I L Le P SS)

黄工！你发的这个网址打不开