[LISP程序]：用几何方法求两圆交点的LISP程序

kerryout

2. (defun c:cirinter()
   
3.   (setq pt1 (getpoint "/nfirst center:"))
   
4.   (setq r1 (getreal "/nfirst radius:"))
   
5.   (command "circle" pt1 r1)
   
6. 
   
7.   (setq pt2 (getpoint "/nsecond center:"))
   
8.   (setq r2 (getreal "/nsecond radius:"))
   
9.   (command "circle" pt2 r2)
   
10. 
    
11.   (setq d (distance pt1 pt2))
    
12.   (setq a (* 2.0 r1 d)) (princ a)
    
13.   (setq b (- (+ (* r1 r1) (* d d)) (* r2 r2)))
    
14.   (setq c (sqrt (- (* a a) (* b b))))
    
15. 
    
16.   
    
17.   (setq ang1 (atan c a))
    
18.   (setq ang2 (angle pt1 pt2))
    
19. 
    
20.   (setq pt0 (polar pt1 (+ ang1 ang2) r1))
    
21. 
    
22.   (command "line" pt0 pt1)
    
23.   )

(defun c:cirinter()<br />   (setq pt1 (getpoint "/nfirst center:"))<br />   (setq r1 (getreal "/nfirst radius:"))<br />   (command "circle" pt1 r1)<br /> <br />   (setq pt2 (getpoint "/nsecond center:"))<br />   (setq r2 (getreal "/nsecond radius:"))<br />   (command "circle" pt2 r2)<br /> <br />   (setq d (distance pt1 pt2))<br />   (setq a (* 2.0 r1 d)) (princ a) <br />   (setq b (- (+ (* r1 r1) (* d d)) (* r2 r2))) <br />   (setq c (sqrt (- (* a a) (* b b))))<br /> <br />   <br />   (setq ang1 (atan c a))<br />   (setq ang2 (angle pt1 pt2))<br /> <br />   (setq pt0 (polar pt1 (+ ang1 ang2) r1))<br /> <br />   (command "line" pt0 pt1)<br />   )

雨箭风刀

两个圆的交点可能：
1。没有
2。一个交点
3。2个交点

kerryout

谢谢楼主，这是在已知有两个交点的情况下，求交点的。

xyp1964

参考：

2. [FONT=courier new];;;两圆交点
   
3. (defun c:test068 (/ ena        enb e-a        e-b a b        c pt1 ptb ang ang-a ang-b pt1
   
4.                   pt2 pta)
   
5.   (CMDLA0)
   
6.   (while (/= ena "CIRCLE")
   
7.     (while (not (setq e-a (car (entsel "\n选择圆1 : ")))))
   
8.     (setq ena (xyp-get-DXF 0 e-a))
   
9.   )
   
10.   (redraw e-a 3)
    
11.   (while (/= enb "CIRCLE")
    
12.     (while (not (setq e-b (car (entsel "\n选择圆2 : ")))))
    
13.     (setq enb (xyp-get-DXF 0 e-b))
    
14.   )
    
15.   (redraw e-b 3)
    
16.   (setq        tx1 (UKWORD 1 "1 2" "\n1-连线/2-示意" tx1)
    
17.         a   (xyp-get-DXF 40 e-a)
    
18.         b   (xyp-get-DXF 40 e-b)
    
19.         pta (xyp-get-DXF 10 e-a)
    
20.         ptb (xyp-get-DXF 10 e-b)
    
21.         c   (abs (distance pta ptb))
    
22.         ang (angle pta ptb)
    
23.   )
    
24.   (if (and (> (+ a b) c) (> (+ a c) b) (> (+ c b) a))
    
25.     (progn
    
26.       (setq ang-a (/ (- (+ (* b b) (* c c)) (* a a)) (* 2 b c))
    
27.             ang-a (atan (sqrt (- 1 (* ang-a ang-a))) ang-a)
    
28.             ang-b (/ (- (+ (* a a) (* c c)) (* b b)) (* 2 a c))
    
29.             ang-b (atan (sqrt (- 1 (* ang-b ang-b))) ang-b)
    
30.             ang-c (/ (- (+ (* b b) (* a a)) (* c c)) (* 2 b a))
    
31.       )
    
32.       (setq pt1        (inters        pta
    
33.                         (polar pta (+ ang ang-b) 1000)
    
34.                         ptb
    
35.                         (polar ptb (- ang ang-a) 1000)
    
36.                         nil
    
37.                 )
    
38.             pt2        (inters        pta
    
39.                         (polar pta (- ang ang-b) 1000)
    
40.                         ptb
    
41.                         (polar ptb (+ ang ang-a) 1000)
    
42.                         nil
    
43.                 )
    
44.       )
    
45.       (if (= tx1 "1")
    
46.         (command "line" pt1 pt2 "")
    
47.         (grvecs (list 1 pt1 pt2))
    
48.       )
    
49.       (princ "\n交点1 = ")
    
50.       (princ pt1)
    
51.       (princ "\n交点2 = ")
    
52.       (princ pt2)
    
53.     )
    
54.     (alert "\n两个圆不相交! ")
    
55.   )
    
56.   (redraw e-a 4)
    
57.   (redraw e-b 4)
    
58.   (CMDLA1)
    
59. )[/FONT]

[FONT=courier new];;;两圆交点<br /> (defun c:test068 (/ ena        enb e-a        e-b a b        c pt1 ptb ang ang-a ang-b pt1<br />                   pt2 pta)<br />   (CMDLA0)<br />   (while (/= ena "CIRCLE")<br />     (while (not (setq e-a (car (entsel "\n选择圆1 : ")))))<br />     (setq ena (xyp-get-DXF 0 e-a))<br />   )<br />   (redraw e-a 3)<br />   (while (/= enb "CIRCLE")<br />     (while (not (setq e-b (car (entsel "\n选择圆2 : ")))))<br />     (setq enb (xyp-get-DXF 0 e-b))<br />   )<br />   (redraw e-b 3)<br />   (setq        tx1 (UKWORD 1 "1 2" "\n1-连线/2-示意" tx1)<br />         a   (xyp-get-DXF 40 e-a)<br />         b   (xyp-get-DXF 40 e-b)<br />         pta (xyp-get-DXF 10 e-a)<br />         ptb (xyp-get-DXF 10 e-b)<br />         c   (abs (distance pta ptb))<br />         ang (angle pta ptb)<br />   )<br />   (if (and (> (+ a b) c) (> (+ a c) b) (> (+ c b) a))<br />     (progn<br />       (setq ang-a (/ (- (+ (* b b) (* c c)) (* a a)) (* 2 b c))<br />             ang-a (atan (sqrt (- 1 (* ang-a ang-a))) ang-a)<br />             ang-b (/ (- (+ (* a a) (* c c)) (* b b)) (* 2 a c))<br />             ang-b (atan (sqrt (- 1 (* ang-b ang-b))) ang-b)<br />             ang-c (/ (- (+ (* b b) (* a a)) (* c c)) (* 2 b a))<br />       )<br />       (setq pt1        (inters        pta<br />                         (polar pta (+ ang ang-b) 1000)<br />                         ptb<br />                         (polar ptb (- ang ang-a) 1000)<br />                         nil<br />                 )<br />             pt2        (inters        pta<br />                         (polar pta (- ang ang-b) 1000)<br />                         ptb<br />                         (polar ptb (+ ang ang-a) 1000)<br />                         nil<br />                 )<br />       )<br />       (if (= tx1 "1")<br />         (command "line" pt1 pt2 "")<br />         (grvecs (list 1 pt1 pt2))<br />       )<br />       (princ "\n交点1 = ")<br />       (princ pt1)<br />       (princ "\n交点2 = ")<br />       (princ pt2)<br />     )<br />     (alert "\n两个圆不相交! ")<br />   )<br />   (redraw e-a 4)<br />   (redraw e-b 4)<br />   (CMDLA1)<br /> )[/FONT]

zhang8755

用vla-intersectwith函数不是更简单，不用自己做几何计算，都自己算，要cad干什么。