一组纯数学实现几何函数

marting

1 点是否在直线上

1. (defun pointonline (pt p0 p1 /)
   
2.   (if (and pt p0 p1)
   
3.     (if        (equal (+ (distance p0 pt) (distance p1 pt))
   
4.                (distance p0 p1)
   
5.                0.00001
   
6.         )
   
7.       T
   
8.     )
   
9.   )
   
10. )
    

(defun pointonline (pt p0 p1 /)<br />   (if (and pt p0 p1)<br />     (if        (equal (+ (distance p0 pt) (distance p1 pt))<br />                (distance p0 p1)<br />                0.00001<br />         )<br />       T<br />     )<br />   )<br /> )<br />

2 圆弧长度

游客，本帖隐藏的内容需要积分高于 50 才可浏览，您当前积分为 0

3 点是否在圆弧上

1. (defun pointonarc (pt cen r pa1 pa2 /)
   
2.   (if (and pa1 pa2)
   
3.     (if
   
4.       (equal (+ (arclength cen r pa1 pt) (arclength cen r pt pa2))
   
5.              (arclength cen r pa1 pa2)
   
6.              0.00001
   
7.       )
   
8.        T
   
9.     )
   
10.     (if        (equal (distance cen pt) r 0.00001)
    
11.       T
    
12.     )
    
13.   )
    
14. )
    

(defun pointonarc (pt cen r pa1 pa2 /)<br />   (if (and pa1 pa2)<br />     (if<br />       (equal (+ (arclength cen r pa1 pt) (arclength cen r pt pa2))<br />              (arclength cen r pa1 pa2)<br />              0.00001<br />       )<br />        T<br />     )<br />     (if        (equal (distance cen pt) r 0.00001)<br />       T<br />     )<br />   )<br /> )<br />

4 直线和圆的交点

1. (defun inters_linecircle (pl1  pl2  cen         r    pa1  pa2        cve  /          x1
   
2.                           y1   x2   y2         h    r2   k        yt1  yt2  pt1
   
3.                           pt2  m    yk2         xt1  xt2  a        b    c          z
   
4.                           lst1
   
5.                          )
   
6.   (setq        x1  (car pl1)
   
7.         y1  (cadr pl1)
   
8.         x2  (car pl2)
   
9.         y2  (cadr pl2)
   
10.         r2  (expt r 2)
    
11.         h   (car cen)
    
12.         xh2 (expt (- x1 h) 2)
    
13.         k   (cadr cen)
    
14.   )
    
15.   (if (equal x2 x1 0.00001)
    
16.     (if        (>= r2 xh2)
    
17.       (setq yt1        (+ (expt (- r2 xh2) 0.5) k)
    
18.             yt2        (- k (expt (- r2 xh2) 0.5))
    
19.             pt1        (list x1 yt1)
    
20.             pt2        (list x1 yt2)
    
21.       )
    
22.     )
    
23.     (progn
    
24.       (setq m (/ (- y2 y1) (- x2 x1)))
    
25.       (if (equal m 0 0.00001)
    
26.         (if (>= r2 (setq yk2 (expt (- y1 k) 2)))
    
27.           (setq        xt1 (+ (expt (- r2 yk2) 0.5) h)
    
28.                 xt2 (- h (expt (- r2 yk2) 0.5))
    
29.                 pt1 (list xt1 y1)
    
30.                 pt2 (list xt2 y2)
    
31.           )
    
32.         )
    
33.         (progn
    
34.           (setq        a (+ 1.0 (expt m 2))
    
35.                 b (- (* 2.0 m (- x1 h (* m k))) (* 2.0 y1))
    
36.                 c (+ (expt (+ (* m (- h x1)) y1) 2)
    
37.                      (* (expt m 2) (- (expt k 2) r2))
    
38.                   )
    
39.           )
    
40.           (if (>= (setq z (- (expt b 2) (* 4 a c))) 0)
    
41.             (setq yt1 (/ (- (expt z 0.5) b) (* 2.0 a))
    
42.                   yt2 (/ (* -1.0 (+ (expt z 0.5) b)) (* 2.0 a))
    
43.                   xt1 (+ (/ (- yt1 y1) m) x1)
    
44.                   xt2 (+ (/ (- yt2 y1) m) x1)
    
45.                   pt1 (list xt1 yt1)
    
46.                   pt2 (list xt2 yt2)
    
47.             )
    
48.           )
    
49.         )
    
50.       )
    
51.     )
    
52.   )
    
53.   (if (= cve "")
    
54.     (progn
    
55.       (if (and pt1
    
56.                (pointonline pt1 pl1 pl2)
    
57.                (pointonarc pt1 cen r pa1 pa2)
    
58.           )
    
59.         (setq lst1 (append lst1 (list pt1)))
    
60.       )
    
61.       (if (and pt2
    
62.                (pointonline pt2 pl1 pl2)
    
63.                (pointonarc pt2 cen r pa1 pa2)
    
64.           )
    
65.         (setq lst1 (append lst1 (list pt2)))
    
66.       )
    
67.     )
    
68.     (setq lst1 (append lst1 (list pt1) (list pt2)))
    
69.   )
    
70.   lst1
    
71. )
    

(defun inters_linecircle (pl1  pl2  cen         r    pa1  pa2        cve  /          x1<br />                           y1   x2   y2         h    r2   k        yt1  yt2  pt1<br />                           pt2  m    yk2         xt1  xt2  a        b    c          z<br />                           lst1<br />                          )<br />   (setq        x1  (car pl1)<br />         y1  (cadr pl1)<br />         x2  (car pl2)<br />         y2  (cadr pl2)<br />         r2  (expt r 2)<br />         h   (car cen)<br />         xh2 (expt (- x1 h) 2)<br />         k   (cadr cen)<br />   )<br />   (if (equal x2 x1 0.00001)<br />     (if        (>= r2 xh2)<br />       (setq yt1        (+ (expt (- r2 xh2) 0.5) k)<br />             yt2        (- k (expt (- r2 xh2) 0.5))<br />             pt1        (list x1 yt1)<br />             pt2        (list x1 yt2)<br />       )<br />     )<br />     (progn<br />       (setq m (/ (- y2 y1) (- x2 x1)))<br />       (if (equal m 0 0.00001)<br />         (if (>= r2 (setq yk2 (expt (- y1 k) 2)))<br />           (setq        xt1 (+ (expt (- r2 yk2) 0.5) h)<br />                 xt2 (- h (expt (- r2 yk2) 0.5))<br />                 pt1 (list xt1 y1)<br />                 pt2 (list xt2 y2)<br />           )<br />         )<br />         (progn<br />           (setq        a (+ 1.0 (expt m 2))<br />                 b (- (* 2.0 m (- x1 h (* m k))) (* 2.0 y1))<br />                 c (+ (expt (+ (* m (- h x1)) y1) 2)<br />                      (* (expt m 2) (- (expt k 2) r2))<br />                   )<br />           )<br />           (if (>= (setq z (- (expt b 2) (* 4 a c))) 0)<br />             (setq yt1 (/ (- (expt z 0.5) b) (* 2.0 a))<br />                   yt2 (/ (* -1.0 (+ (expt z 0.5) b)) (* 2.0 a))<br />                   xt1 (+ (/ (- yt1 y1) m) x1)<br />                   xt2 (+ (/ (- yt2 y1) m) x1)<br />                   pt1 (list xt1 yt1)<br />                   pt2 (list xt2 yt2)<br />             )<br />           )<br />         )<br />       )<br />     )<br />   )<br />   (if (= cve "")<br />     (progn<br />       (if (and pt1<br />                (pointonline pt1 pl1 pl2)<br />                (pointonarc pt1 cen r pa1 pa2)<br />           )<br />         (setq lst1 (append lst1 (list pt1)))<br />       )<br />       (if (and pt2<br />                (pointonline pt2 pl1 pl2)<br />                (pointonarc pt2 cen r pa1 pa2)<br />           )<br />         (setq lst1 (append lst1 (list pt2)))<br />       )<br />     )<br />     (setq lst1 (append lst1 (list pt1) (list pt2)))<br />   )<br />   lst1<br /> )<br />

kqqt6236

谢谢分享，收藏了。

/db_自贡黄明儒_

直线同弧最近的一个交点，怎么求？

sh_h

谢谢大师分享，收藏了！！！

Lisphk

/db_自贡黄明儒_ 发表于 2017-7-21 07:59

求出两个交点，然后用距离判断哪个更近呗

cnks

谢谢，看看

aeo

直线和圆的交点,是不是应该加入一个参数，看是否要延伸