[LISP程序]：重叠arc合并的初步调试代码！请指正！

fsxm

大体算法为从一列同心弧中0度开始从小到大逆时针搜索
如有重叠就更新对应表中数据没有重叠就表中数据用更新图元!

算法漏洞：比如0~1/2圆与3/4~1/4圆不能合并！
请各位大哥指点一二提供思路感激不尽！

2. 
   
3. (defun dxf (x en)
   
4.   (cdr (assoc x (entget en)))
   
5. )
   
6. (defun aona (a b)                        ;共圆识别
   
7.   (and (equal (dxf 40 a) (dxf 40 b) 0.0001)
   
8.        (equal (dxf 10 a) (dxf 10 b) 0.0001)
   
9.   )
   
10. )
    
11. ;;由arc图元名->(图元名 点弧1 点弧2)
    
12. (defun a->ap1p2        (a / ed sd)
    
13.   (setq ed (dxf 51 a))
    
14.   (setq sd (dxf 50 a))
    
15.   (list        a
    
16.         sd
    
17.         (if (< ed sd)
    
18.           (+ ed (* 2 pi))
    
19.           ed
    
20.         )
    
21.   )
    
22. )
    
23. (defun list-list (a b)                        ;a表与表b之差
    
24.   (foreach tmp b (setq a (vl-remove tmp a)))
    
25. )
    
26. (defun lst-a (lsta / a1 a1lst a2lst lstxy on-a1)
    
27.   (while (setq a1 (car lsta))
    
28.     (setq on-a1        (cons a1
    
29.                       (vl-remove-if-not
    
30.                         '(lambda (x) (aona a1 x))
    
31.                         (cdr lsta)
    
32.                       )
    
33.                 )
    
34.     )
    
35.     ;;on-a1 是与a1共圆的一列表
    
36.     (setq lsta (list-list lsta on-a1))
    
37.     (setq a1lst (mapcar 'a->ap1p2 on-a1))
    
38.     (setq a2lst (vl-sort a1lst '(lambda (a b) (< (cadr a) (cadr b)))))
    
39.     (a+a a2lst)
    
40.   )
    
41. )
    
42. ;;以新的(arc p1 p2) 来更新arc
    
43. (defun entmodlist (ap1p2 / a51 a50 alist ass51)
    
44.   (setq a51 (caddr ap1p2))
    
45.   (setq a50 (cadr ap1p2))
    
46.   (setq alist (entget (car ap1p2)))
    
47.   (if (> (- a51 a50) (* 2 pi))
    
48.     (progn
    
49.       (entdel (car ap1p2))
    
50.       (entmakex
    
51.         (cons
    
52.           '(0 . "circle")
    
53.           (mapcar 'assoc '(8 10 40) (list alist alist alist))
    
54.         )
    
55.       )
    
56.     )
    
57.     (progn
    
58.       (if (> a51 (* 2 pi))
    
59.         (setq a51 (rem a51 (* 2 pi)))
    
60.       )
    
61.       (setq a51          (cons 51 (caddr ap1p2))
    
62.             alist (entget (car ap1p2))
    
63.             ass51 (assoc 51 alist)
    
64.             alist (subst a51 ass51 alist)
    
65.       )
    
66.       (entmod alist)
    
67.     )
    
68.   )
    
69.   (setq md 0)
    
70. )
    
71. ;;处理一系列共圆对像列表
    
72. (defun a+a (aplis / als b ea eb k sb)
    
73.   (setq k 0)
    
74.   (setq als (car aplis))
    
75.   (repeat (1- (length aplis))
    
76.     (setq b (nth (setq k (1+ k)) aplis))
    
77.     (setq ea (caddr als)
    
78.           sa (cadr als)
    
79.           sb (cadr b)
    
80.           eb (caddr b)
    
81.     )
    
82.     (cond
    
83.       ((> (- sb ea) 1e-5)
    
84.        (if
    
85.          (= md 1)
    
86.           (entmodlist als)
    
87.        )
    
88.        (setq als b)
    
89.       )
    
90.       ((< ea eb)
    
91.        (setq als (subst (caddr b) (caddr als) als)
    
92.              md         1
    
93.        )
    
94.        (entdel (car b))
    
95.       )
    
96.       ((>= ea eb)
    
97.        (entdel (car b))
    
98.       )
    
99.     )
    
100.   )
     
101.   (if (= md 1)
     
102.     (entmodlist als)
     
103.   )
     
104. )
     
105. (defun c:aanda (/ en n ss ssarc t1 time)
     
106.   (setq ss (ssget '((0 . "arc"))))
     
107.   (setq t1 (getvar "date"))
     
108.   (setq n 0)
     
109.   (repeat (sslength ss)
     
110.     (setq en (ssname ss n))
     
111.     (setq ssarc (cons en ssarc))
     
112.     (setq n (1+ n))
     
113.   )
     
114.   (command ".undo" "be")
     
115.   (lst-a ssarc)
     
116.   (setq time (rtos (- (getvar "date") t1) 2 16))
     
117.   (command ".undo" "e")
     
118.   (if (= time "0")
     
119.     (princ " > 程序太快了啦没啥用时啦！")
     
120.     (princ (strcat " > 用时:"
     
121.                    (menucmd (strcat "m=$(edtime,"
     
122.                                     time
     
123.                                     ",hh:mm:ss:msec)"
     
124.                             )
     
125.                    )
     
126.            )
     
127.     )
     
128.   )
     
129.   (princ)
     
130. )
     

<br /> (defun dxf (x en)<br />   (cdr (assoc x (entget en)))<br /> )<br /> (defun aona (a b)                        ;共圆识别<br />   (and (equal (dxf 40 a) (dxf 40 b) 0.0001)<br />        (equal (dxf 10 a) (dxf 10 b) 0.0001)<br />   )<br /> )<br /> ;;由arc图元名->(图元名 点弧1 点弧2)<br /> (defun a->ap1p2        (a / ed sd)<br />   (setq ed (dxf 51 a))<br />   (setq sd (dxf 50 a))<br />   (list        a<br />         sd<br />         (if (< ed sd)<br />           (+ ed (* 2 pi))<br />           ed<br />         )<br />   )<br /> )<br /> (defun list-list (a b)                        ;a表与表b之差<br />   (foreach tmp b (setq a (vl-remove tmp a)))<br /> )<br /> (defun lst-a (lsta / a1 a1lst a2lst lstxy on-a1)<br />   (while (setq a1 (car lsta))<br />     (setq on-a1        (cons a1<br />                       (vl-remove-if-not<br />                         '(lambda (x) (aona a1 x))<br />                         (cdr lsta)<br />                       )<br />                 )<br />     )<br />     ;;on-a1 是与a1共圆的一列表<br />     (setq lsta (list-list lsta on-a1))<br />     (setq a1lst (mapcar 'a->ap1p2 on-a1))<br />     (setq a2lst (vl-sort a1lst '(lambda (a b) (< (cadr a) (cadr b)))))<br />     (a+a a2lst)<br />   )<br /> )<br /> ;;以新的(arc p1 p2) 来更新arc<br /> (defun entmodlist (ap1p2 / a51 a50 alist ass51)<br />   (setq a51 (caddr ap1p2))<br />   (setq a50 (cadr ap1p2))<br />   (setq alist (entget (car ap1p2)))<br />   (if (> (- a51 a50) (* 2 pi))<br />     (progn<br />       (entdel (car ap1p2))<br />       (entmakex<br />         (cons<br />           '(0 . "circle")<br />           (mapcar 'assoc '(8 10 40) (list alist alist alist))<br />         )<br />       )<br />     )<br />     (progn<br />       (if (> a51 (* 2 pi))<br />         (setq a51 (rem a51 (* 2 pi)))<br />       )<br />       (setq a51          (cons 51 (caddr ap1p2))<br />             alist (entget (car ap1p2))<br />             ass51 (assoc 51 alist)<br />             alist (subst a51 ass51 alist)<br />       )<br />       (entmod alist)<br />     )<br />   )<br />   (setq md 0)<br /> )<br /> ;;处理一系列共圆对像列表<br /> (defun a+a (aplis / als b ea eb k sb)<br />   (setq k 0)<br />   (setq als (car aplis))<br />   (repeat (1- (length aplis))<br />     (setq b (nth (setq k (1+ k)) aplis))<br />     (setq ea (caddr als)<br />           sa (cadr als)<br />           sb (cadr b)<br />           eb (caddr b)<br />     )<br />     (cond<br />       ((> (- sb ea) 1e-5)<br />        (if<br />          (= md 1)<br />           (entmodlist als)<br />        )<br />        (setq als b)<br />       )<br />       ((< ea eb)<br />        (setq als (subst (caddr b) (caddr als) als)<br />              md         1<br />        )<br />        (entdel (car b))<br />       )<br />       ((>= ea eb)<br />        (entdel (car b))<br />       )<br />     )<br />   )<br />   (if (= md 1)<br />     (entmodlist als)<br />   )<br /> )<br /> (defun c:aanda (/ en n ss ssarc t1 time)<br />   (setq ss (ssget '((0 . "arc"))))<br />   (setq t1 (getvar "date"))<br />   (setq n 0)<br />   (repeat (sslength ss)<br />     (setq en (ssname ss n))<br />     (setq ssarc (cons en ssarc))<br />     (setq n (1+ n))<br />   )<br />   (command ".undo" "be")<br />   (lst-a ssarc)<br />   (setq time (rtos (- (getvar "date") t1) 2 16))<br />   (command ".undo" "e")<br />   (if (= time "0")<br />     (princ " > 程序太快了啦没啥用时啦！")<br />     (princ (strcat " > 用时:"<br />                    (menucmd (strcat "m=$(edtime,"<br />                                     time<br />                                     ",hh:mm:ss:msec)"<br />                             )<br />                    )<br />            )<br />     )<br />   )<br />   (princ)<br /> )<br />

飞马牌汽车

程序确实对大部分的重叠圆弧是可以的。
我认为这个不能合并的主要问题出在：圆弧角度定义的特殊性，跨越0度线会有些意外
当圆跨越x轴，比如起始是300度，终点是10度的时候，它会把终点定为370度，此时
(< ea eb)就不一定成立
必须增加一些改进措施来对这些穿过0度线的圆弧角度进行修正，应该就可以的。
否则这种情况下，会产生md＝0而无法进行更新的情况。

fsxm

谢谢！
问题终于解决了！！

eachy

重叠圆弧首先要圆心重叠，半径相等，然后就是判断角度。ARC 用的是ECS，而且角度总是逆时针

雨箭风刀

效果不理想，发个测试图

fsxm

雨箭风刀  兄你的测试图我试过了请用我最新发布的：合并重元
http://www.xdcad.net/forum/showthread.php?s=&threadid=567208

命令: xz
指定直线合并时允许座标间隙<0.001>:
指定圆弧合并时允许角度间隙<1°>:
选择对象: 指定对角点: 找到 18 个

选择对象:

选取了:< 18 >合并了:< 13 > 用时:00:00:00:050

看看最后的效果图：

Free-Lancer

再写这些就费时了，2007 下已经有 Join 命令