[求助]恳请帮助：统计圆数量时如何去掉重复圆

SunSpring

1. (DEFUN DELETESAMEHOLES (SS_CIRCLE)
2.   (SETQ ERASE_SUM 0
3. I   0
4. N   (SSLENGTH SS_CIRCLE)
5. ZN   N
6.   )
7.   (WHILE (/= N 0)
8.     (PROGN
9.       (SETQ ED (ENTGET (SSNAME SS_CIRCLE I))
10.      RAD (CDR (ASSOC '40 ED))
11.      X (CADR (ASSOC 10 ED))
12.      Y (CADDR (ASSOC 10 ED))
13.      Z (LAST (ASSOC 10 ED))
14.       )
15.       (SETQ J (+ I 1))
16.       (REPEAT (- (- ZN I) 1)
17. (PROGN
18.    (SETQ ENT  (SSNAME SS_CIRCLE J)
19.   ED  (ENTGET ENT)
20.   X_SAME  (CADR (ASSOC 10 ED))
21.   Y_SAME  (CADDR (ASSOC 10 ED))
22.   Z_SAME  (LAST (ASSOC 10 ED))
23.   RAD_SAME (CDR (ASSOC '40 ED))
24.    )
25.    (IF (AND (EQUAL X_SAME X 0.00001)
26.      (EQUAL Y_SAME Y 0.00001)
27.      (EQUAL Z_SAME Z 0.00001)
28.      (EQUAL RAD_SAME RAD 0.00001)
29.        )
30.      (PROGN
31.        (SSDEL ENT SS_CIRCLE)
32.        (COMMAND "ERASE" ENT "")
33.        (SETQ N       (- N 1)
34.       ERASE_SUM (1+ ERASE_SUM)
35.        )
36.      )
37.      (SETQ J (+ J 1))
38.    )
39. )
40.       )
41.       (SETQ ZN (SSLENGTH SS_CIRCLE))
42.       (IF (< I (- (SSLENGTH SS_CIRCLE) 1))
43. (SETQ I (1+ I))
44.       )
45.       (SETQ N (- N 1))
46.     )
47.   )
48.   (IF (/= ERASE_SUM 0)
49.     (PROGN
50.       (REDRAW)
51.       (ALERT (STRCAT "\n 有 "
52.        (RTOS ERASE_SUM 2 0)
53.        " 个重复的孔将被删除!!! "
54.       )
55.       )
56.     )
57.   )
58.   SS_CIRCLE
59. )

复制代码

这是以有写的一程序里面用到的,可以控制精度.
因为两圆重叠时,不一定刚好是同心或等半径.

无痕

2. (defun c:tt (/ ss i e ent cpt r pts)
3.   (setq ss(ssget '((0 . "CIRCLE")))
4. fz (getdist "\n 圆心&半径误差(误差值内按1个计算):")
5.         i -1)
6.   (while(setq e(ssname ss(setq i(1+ i))))
7.    (setq ent (entget e)
8.   cpt (cdr(assoc 10 ent))
9.   r   (cdr(assoc 40 ent)))
10.    (if (not(member 'T (mapcar '(lambda(x)(and(equal cpt (car x) fz)(equal r (cadr x) fz)))pts)))
11.    (setq pts (cons (list cpt r) pts))
12.    )
13.    ) (length pts)
14. )

(defun c:tt (/ ss i e ent cpt r pts)   (setq ss(ssget '((0 . "CIRCLE"))) fz (getdist "\n 圆心&半径误差(误差值内按1个计算):")         i -1)   (while(setq e(ssname ss(setq i(1+ i))))    (setq ent (entget e)   cpt (cdr(assoc 10 ent))   r   (cdr(assoc 40 ent)))    (if (not(member 'T (mapcar '(lambda(x)(and(equal cpt (car x) fz)(equal r (cadr x) fz)))pts)))    (setq pts (cons (list cpt r) pts))    )    ) (length pts) )

WELLDICK

楼主，相关命令是什么啊？我不是很清楚啊，谢谢！

liguofeng3909@126.com

yhkk0317

回复 无痕 的帖子

简洁.实用.明了.很好

ljttjl

或http://ljttjl.ys168.com 2009-2试用程序及演示  20091111删除完全重叠图元对象 目录下载此程序
以下为此程序演示：

183017064

phoenixdjq 发表于 2006-12-29 20:47
给你一个网上下载的删除重线的程序，谁做的我忘了你可以先把多余的圆删除，然后再计算，就可以了&nbsp;

好用，谢谢大佬分享，学习了。居然是18年前的东西，太强了