椭圆的26种作图法---椭圆论（下）

Highflybird

此文之题目，颇有当年孔乙己 “茴”字四种写法之意。
椭圆之作图法，难矣！ 今再用LISP论述之，无视其意义和价值，似有闭门造车之嫌。但此念在心中一直作祟，不吐不快，故今发表于此，望读者斧正谬误之处。

说明：此LISP程序参考了《Constructive Geometry of Plane Curves》 (T.H. Eagles著)中的几何作图法。
程序中字母代表的含义:
C----Center, The center of Ellipse, 椭圆的中心
F----Focus, The focus(foci) of Ellipse, 椭圆的焦点
X----Axis, An axis of Ellipse, 椭圆的轴
P----Point, A Point on Ellipse, 椭圆上的一点
T----Tangent, A tangent of Ellipse, 椭圆的切线
J----conjugate diameter, 共轭轴
D----Direction, 已知某个共轭轴的方向
M----Major Direction, 已知主轴的方向

另外，如需要程序完整运行，需加载本人的其他一些库文件：
矩阵库Matrix-lib.LSP

请点击此处下载

请先注册会员后在进行下载

已注册会员，请先登录后下载

文件名称:Matrix-Lib.LSP 
下载次数:37  文件大小:60.93 KB  售价:20D豆 [记录]
下载权限: 不限 以上  [免费赚D豆]

点线面几何库 Line&**.LSP

请点击此处下载

请先注册会员后在进行下载

已注册会员，请先登录后下载

文件名称:Line&**.LSP 
下载次数:27  文件大小:70.78 KB  售价:20D豆 [记录]
下载权限: 不限 以上  [免费赚D豆]

复数库Complex.LSP

请点击此处下载

请先注册会员后在进行下载

已注册会员，请先登录后下载

文件名称:COMPLEX.LSP 
下载次数:22  文件大小:22.17 KB  售价:20D豆 [记录]
下载权限: 不限 以上  [免费赚D豆]

圆弧库 Circle.LSP

请点击此处下载

请先注册会员后在进行下载

已注册会员，请先登录后下载

文件名称:Circle.LSP 
下载次数:26  文件大小:72.03 KB  售价:20D豆 [记录]
下载权限: 不限 以上  [免费赚D豆]

此文贴上的代码仅仅为片段代码。完整代码见附件，包含了一些测试代码。

请点击此处下载

请先注册会员后在进行下载

已注册会员，请先登录后下载

文件名称:ellipse.LSP 
下载次数:23  文件大小:107.08 KB  售价:20D豆 [记录]
下载权限: 不限 以上  [免费赚D豆]

申明：如读者需转载，请注明原作者及其引用地址。

题1：给定椭圆的两共轭半轴CP,CQ,求此椭圆。
关于什么叫椭圆的共轭轴，请读者自行搜索定义。

此题的另外一解法参见《Constructive Geometry of Plane Curves》 (T.H. Eagles著)的110页，63题。

1. ;;;=============================================================
   
2. ;;; Given a pair of conjugate diameters, construct an ellipse   
   
3. ;;; 功能: 已知两共轭半轴作椭圆                                 
   
4. ;;; 输入: 共轭轴的交点C(即椭圆圆心)、共轭半轴的两端点P,Q        
   
5. ;;; 输出: 成功返回椭圆的基本要素，否则返回nil                  
   
6. ;;;=============================================================
   
7. (defun ELL:2J (C P Q / K M R A)
   
8.   (if (not (LINE:Colinearity C P Q))
   
9.     (progn
   
10.       (setq K (GEO:Rot90 C C Q))                                ;Q点绕C旋转90度得到K
    
11.       (setq M (GEO:Midpoint K P))                                ;M为KP的中点
    
12.       (setq R (distance M C))                                        ;以M为圆心，MC为半径画圆，
    
13.       (setq A (polar M (angle M P) R))                          ;交KP于A,B
    
14.       (list C (distance K A) (distance P A) (angle C A))        ;则CA,CB为椭圆的两轴线方向，半轴长分别为KA，PA.
    
15.     )
    
16.   )
    
17. )

;;;=============================================================<br /> ;;; Given a pair of conjugate diameters, construct an ellipse   <br /> ;;; 功能: 已知两共轭半轴作椭圆                                  <br /> ;;; 输入: 共轭轴的交点C(即椭圆圆心)、共轭半轴的两端点P,Q        <br /> ;;; 输出: 成功返回椭圆的基本要素，否则返回nil                   <br /> ;;;=============================================================<br /> (defun ELL:2J (C P Q / K M R A)<br />   (if (not (LINE:Colinearity C P Q))<br />     (progn<br />       (setq K (GEO:Rot90 C C Q))                                ;Q点绕C旋转90度得到K<br />       (setq M (GEO:Midpoint K P))                                ;M为KP的中点<br />       (setq R (distance M C))                                        ;以M为圆心，MC为半径画圆，<br />       (setq A (polar M (angle M P) R))                          ;交KP于A,B<br />       (list C (distance K A) (distance P A) (angle C A))        ;则CA,CB为椭圆的两轴线方向，半轴长分别为KA，PA.<br />     )<br />   )<br /> )

题2：给定椭圆的长轴MN和椭圆上一点P，求此椭圆:

这个稍微简单，我在这里采用了数学法，直接求出。

1. ;;;=============================================================
   
2. ;;; Construct an ellipse,one axis and a point on it being given.
   
3. ;;; Note: Page 114, Problem 64                                 
   
4. ;;; 功能: 已知椭圆的一个长轴，和椭圆上的一点                    
   
5. ;;; 输入: 长轴的两个端点M、N和椭圆上的一点P                     
   
6. ;;; 输出: 成功返回椭圆的基本要素，否则返回nil                  
   
7. ;;;=============================================================
   
8. (defun ELL:XP (M N P / C a b Maj Vec x y d)
   
9.   (setq C (Geo:Midpoint M N))
   
10.   (setq A (distance C M))
    
11.   (setq Maj (mapcar '- M C))
    
12.   (setq vec (trans (mapcar '- P C) 0 Maj T))                           
    
13.   (setq x (caddr vec))
    
14.   (setq y (car vec))
    
15.   (if (not (>= (abs x) a))
    
16.     (progn
    
17.       (setq d (sqrt (* (+ a x) (- a x))))
    
18.       (setq b (abs (* (/ y d) a)))
    
19.       (list C a b (angle C M))
    
20.     )
    
21.   )
    
22. )

;;;=============================================================<br /> ;;; Construct an ellipse,one axis and a point on it being given.<br /> ;;; Note: Page 114, Problem 64                                  <br /> ;;; 功能: 已知椭圆的一个长轴，和椭圆上的一点                    <br /> ;;; 输入: 长轴的两个端点M、N和椭圆上的一点P                     <br /> ;;; 输出: 成功返回椭圆的基本要素，否则返回nil                   <br /> ;;;=============================================================<br /> (defun ELL:XP (M N P / C a b Maj Vec x y d)<br />   (setq C (Geo:Midpoint M N))<br />   (setq A (distance C M))<br />   (setq Maj (mapcar '- M C))<br />   (setq vec (trans (mapcar '- P C) 0 Maj T))                            <br />   (setq x (caddr vec))<br />   (setq y (car vec))<br />   (if (not (>= (abs x) a))<br />     (progn<br />       (setq d (sqrt (* (+ a x) (- a x))))<br />       (setq b (abs (* (/ y d) a)))<br />       (list C a b (angle C M))<br />     )<br />   )<br /> )

题3：给定椭圆的一个长轴MN，和椭圆的一条切线PQ，求此椭圆。

此题采用了两种方法求解，作图法和数学法。这是作图法的代码:

1. (defun ELL:XT_1 (M N P Q / C A Maj I L x Ang G H J)
   
2.   (setq C (Geo:Midpoint M N))
   
3.   (setq A (distance C M))
   
4.   (setq Maj (mapcar '- M C))
   
5.   (if (setq I (inters M N P Q nil))
   
6.     (progn
   
7.       (setq L (distance C I))
   
8.       (setq x (/ (* a a) L))
   
9.       (setq ang (angle C I))
   
10.       (setq G (polar C ang (abs x)))
    
11.       (setq H (polar G (+ ang (* pi 0.5)) a))
    
12.       (if (setq J (inters G H P Q nil))
    
13.         (ELL:XP M N J)
    
14.       )
    
15.     )
    
16.     (progn
    
17.       (setq ang (angle C M))
    
18.       (setq G (polar C (+ ang (* pi 0.5)) A))
    
19.       (if (setq H (inters C G P Q nil))
    
20.         (list C a (distance C H) ang)
    
21.       )
    
22.     )
    
23.   )
    
24. )

(defun ELL:XT_1 (M N P Q / C A Maj I L x Ang G H J)<br />   (setq C (Geo:Midpoint M N))<br />   (setq A (distance C M))<br />   (setq Maj (mapcar '- M C))<br />   (if (setq I (inters M N P Q nil))<br />     (progn <br />       (setq L (distance C I))<br />       (setq x (/ (* a a) L))<br />       (setq ang (angle C I))<br />       (setq G (polar C ang (abs x)))<br />       (setq H (polar G (+ ang (* pi 0.5)) a))<br />       (if (setq J (inters G H P Q nil))<br />         (ELL:XP M N J)<br />       )<br />     )<br />     (progn<br />       (setq ang (angle C M))<br />       (setq G (polar C (+ ang (* pi 0.5)) A))<br />       (if (setq H (inters C G P Q nil))<br />         (list C a (distance C H) ang)<br />       )<br />     )<br />   )<br /> )

题4：给定椭圆的两个共轭轴方向，一条切线和这个切点，求此椭圆。

1. ;;;=============================================================
   
2. ;;; To decribe an ellipse, the directions of a pair of conjugate
   
3. ;;; diameters, a tangent and its point of contact being given   
   
4. ;;; Note: Page 116, Problem 66                                 
   
5. ;;; 功能: 已知椭圆的两个共轭轴方向，一条切线和这个切点         
   
6. ;;; 输入: 两条共轭轴JK和MN,切线PQ并切于P点                     
   
7. ;;; 输出: 成功返回椭圆的基本要素，否则返回nil                  
   
8. ;;;=============================================================
   
9. (defun ELL:TP2D (J K M N P Q / C G H A B E F U W r s x y)
   
10.   (if (and (setq C (inters J K M N nil))
    
11.            (setq G (inters P Q J K nil))
    
12.            (setq H (inters P Q M N nil))
    
13.       )
    
14.     (progn
    
15.       (setq A (angle C G))
    
16.       (setq B (angle C H))
    
17.       (setq U (inters P (polar P B 1) J K nil))
    
18.       (setq W (inters P (polar P A 1) M N nil))
    
19.       (setq r (distance C G))
    
20.       (setq s (distance C H))
    
21.       (setq x (distance C U))
    
22.       (setq y (distance C W))
    
23.       (if (and (< x r) (< y s))
    
24.         (progn
    
25.           (setq x (sqrt (* x r)))
    
26.           (setq y (sqrt (* y s)))
    
27.           (setq E (polar C A X))
    
28.           (setq F (polar C B Y))
    
29.           (ELL:2J C E F)
    
30.         )
    
31.       )
    
32.     )
    
33.   )
    
34. )

;;;=============================================================<br /> ;;; To decribe an ellipse, the directions of a pair of conjugate<br /> ;;; diameters, a tangent and its point of contact being given   <br /> ;;; Note: Page 116, Problem 66                                  <br /> ;;; 功能: 已知椭圆的两个共轭轴方向，一条切线和这个切点          <br /> ;;; 输入: 两条共轭轴JK和MN,切线PQ并切于P点                      <br /> ;;; 输出: 成功返回椭圆的基本要素，否则返回nil                   <br /> ;;;=============================================================<br /> (defun ELL:TP2D (J K M N P Q / C G H A B E F U W r s x y)<br />   (if (and (setq C (inters J K M N nil))<br />            (setq G (inters P Q J K nil))<br />            (setq H (inters P Q M N nil))<br />       )<br />     (progn<br />       (setq A (angle C G))<br />       (setq B (angle C H))<br />       (setq U (inters P (polar P B 1) J K nil))<br />       (setq W (inters P (polar P A 1) M N nil))<br />       (setq r (distance C G))<br />       (setq s (distance C H))<br />       (setq x (distance C U))<br />       (setq y (distance C W))<br />       (if (and (< x r) (< y s))<br />         (progn <br />           (setq x (sqrt (* x r)))<br />           (setq y (sqrt (* y s)))<br />           (setq E (polar C A X))<br />           (setq F (polar C B Y))<br />           (ELL:2J C E F)<br />         )<br />       )<br />     )<br />   )<br /> )

      

题5：已知椭圆的中心，上面两点和一对共轭轴的方向，求此椭圆。

1. ;;;=============================================================
   
2. ;;; To describe an ellipse, the center, two points on the curve
   
3. ;;; and directions of a pair of conjugate diameters being given.
   
4. ;;; Note: Page 116, Problem 67                                 
   
5. ;;; 功能: 已知椭圆的中心，上面两点和一对共轭轴的方向，求此椭圆  
   
6. ;;; 输入: 中心C,共轭轴CM和CN, 两点P,Q.                          
   
7. ;;; 输出: 成功返回椭圆的基本要素，否则返回nil                  
   
8. ;;;=============================================================
   
9. (defun ELL:C2D2P (C M N P Q / A B D E F G I P1 Q1 R S U W X Y Z)
   
10.   (if (and  (inters P Q C M nil) (inters P Q C N nil))
    
11.     (progn
    
12.       (setq x (angle C M))
    
13.       (setq y (angle C N))
    
14.       (setq D (inters P (polar P x 1) C N nil))
    
15.       (setq S (inters Q (polar Q y 1) C M nil))
    
16.       (setq E (inters P D Q S nil))
    
17.       (setq P1 (polar D (angle P D) (distance P D)))
    
18.       (setq Q1 (polar S (angle Q S) (distance Q S)))
    
19.       (setq F (polar S (angle P Q) 1))
    
20.       (setq F (inters S F D E nil))
    
21.       (setq G (polar S (angle P1 Q1) 1))
    
22.       (setq G (inters S G D E nil))
    
23.       (setq z (sqrt (* (distance E F) (distance E G))))
    
24.       (setq i (angle E P))
    
25.       (setq r (distance P D))
    
26.       (setq a (sqrt (+ (* r r) (* z z))))
    
27.       (setq U (polar C I a))
    
28.       (setq b (/ (* (distance C D) a) z))
    
29.       (setq W (polar C (angle C D) b))
    
30.       (ELL:2J C U W)
    
31.     )
    
32.   )
    
33. )

;;;=============================================================<br /> ;;; To describe an ellipse, the center, two points on the curve <br /> ;;; and directions of a pair of conjugate diameters being given.<br /> ;;; Note: Page 116, Problem 67                                  <br /> ;;; 功能: 已知椭圆的中心，上面两点和一对共轭轴的方向，求此椭圆  <br /> ;;; 输入: 中心C,共轭轴CM和CN, 两点P,Q.                          <br /> ;;; 输出: 成功返回椭圆的基本要素，否则返回nil                   <br /> ;;;=============================================================<br /> (defun ELL:C2D2P (C M N P Q / A B D E F G I P1 Q1 R S U W X Y Z)<br />   (if (and  (inters P Q C M nil) (inters P Q C N nil))<br />     (progn<br />       (setq x (angle C M))<br />       (setq y (angle C N))<br />       (setq D (inters P (polar P x 1) C N nil))<br />       (setq S (inters Q (polar Q y 1) C M nil))<br />       (setq E (inters P D Q S nil))<br />       (setq P1 (polar D (angle P D) (distance P D)))<br />       (setq Q1 (polar S (angle Q S) (distance Q S)))<br />       (setq F (polar S (angle P Q) 1))<br />       (setq F (inters S F D E nil))<br />       (setq G (polar S (angle P1 Q1) 1))<br />       (setq G (inters S G D E nil))<br />       (setq z (sqrt (* (distance E F) (distance E G))))<br />       (setq i (angle E P))<br />       (setq r (distance P D))<br />       (setq a (sqrt (+ (* r r) (* z z))))<br />       (setq U (polar C I a))<br />       (setq b (/ (* (distance C D) a) z))<br />       (setq W (polar C (angle C D) b))<br />       (ELL:2J C U W)<br />     )<br />   )<br /> )

题6：已知椭圆的中心，主轴的方向，和两切线，求此椭圆。

1. ;;;=============================================================
   
2. ;;; To describe an ellipse, the center, direction of the major  
   
3. ;;; axis and two tangents being given.                          
   
4. ;;; Note: Page 118, Problem 68                                 
   
5. ;;; 功能: 已知椭圆的中心，主轴的方向，和两切线，求此椭圆        
   
6. ;;; 输入: 中心C,主轴方向CM，和两切线PD，PE（须相交）。         
   
7. ;;; 输出: 成功返回椭圆的基本要素，否则返回nil                  
   
8. ;;;=============================================================
   
9. (defun ELL:CM2T (C M P D E / A A0 A1 A2 A3 A4 A5 B F F1 F2 F3 G H L O R S T1)
   
10.   (setq a0 (angle C M))                                         ;长轴的方向角
    
11.   (setq a1 (angle p D))                                         ;直线一的方向角
    
12.   (setq a2 (angle p E))                                         ;直线二的方向角
    
13.   (setq a3 (* (+ a1 a2) 0.5))                                   ;两直线内角平分线
    
14.   (setq a4 (+ a3 (* pi 0.5)))                                   ;两直线外角平分线
    
15.   (setq G (inters P (polar P a3 1) C M nil))                    ;内角平分线与长轴交于G
    
16.   (setq H (inters P (polar p a4 1) C M nil))                    ;外角平分线与长轴交于H
    
17.   (if (and G H)                                                 ;如果交点都存在（否则无解或无穷解）
    
18.     (progn
    
19.       (setq O (Geo:MidPoint G H))                               ;GH的中点为圆心，GH为直径做作圆
    
20.       (setq R (distance O G))                                   ;OG为这个圆的半径
    
21.       (setq L (distance O C))                                   
    
22.       (if (>= L R)                                              ;如果可以作切线
    
23.         (progn
    
24.           (setq F  (sqrt (* (+ L R) (- L R))))                  ;切线长即为焦距
    
25.           (setq F1 (polar C a0 (- F)))                          ;左焦点F1
    
26.           (setq F2 (polar C a0 F))                              ;右焦点F2
    
27.           (setq F3 (Geo:Mirror2D F1 P a1))                        ;F1关于PD的对称点F3
    
28.           (setq T1 (inters F2 F3 P D nil))                      ;F2F3与PD的交点为切点
    
29.           (setq a5 (* (+ (angle T1 F1) (angle T1 F2)) 0.5))     ;角F1T1F2的平分线
    
30.           (if (equal (rem (- a1 a5) pi) 0 1e-6)                        ;如果平分线与PD重合
    
31.             nil                                                 ;无解
    
32.             (setq a (/ (+ (distance F1 T1) (distance F2 T1)) 2) ;否则得到椭圆的长轴长
    
33.                   b (sqrt (* (- a f) (+ a f)))                  ;由焦距和长轴得到短轴
    
34.                   s (list C a b a0)                             ;因而得解
    
35.             )
    
36.           )
    
37.         )
    
38.       )
    
39.     )
    
40.   )
    
41. )

;;;=============================================================<br /> ;;; To describe an ellipse, the center, direction of the major  <br /> ;;; axis and two tangents being given.                          <br /> ;;; Note: Page 118, Problem 68                                  <br /> ;;; 功能: 已知椭圆的中心，主轴的方向，和两切线，求此椭圆        <br /> ;;; 输入: 中心C,主轴方向CM，和两切线PD，PE（须相交）。          <br /> ;;; 输出: 成功返回椭圆的基本要素，否则返回nil                   <br /> ;;;=============================================================<br /> (defun ELL:CM2T (C M P D E / A A0 A1 A2 A3 A4 A5 B F F1 F2 F3 G H L O R S T1)<br />   (setq a0 (angle C M))                                         ;长轴的方向角<br />   (setq a1 (angle p D))                                         ;直线一的方向角<br />   (setq a2 (angle p E))                                         ;直线二的方向角<br />   (setq a3 (* (+ a1 a2) 0.5))                                   ;两直线内角平分线<br />   (setq a4 (+ a3 (* pi 0.5)))                                   ;两直线外角平分线<br />   (setq G (inters P (polar P a3 1) C M nil))                    ;内角平分线与长轴交于G<br />   (setq H (inters P (polar p a4 1) C M nil))                    ;外角平分线与长轴交于H<br />   (if (and G H)                                                 ;如果交点都存在（否则无解或无穷解）<br />     (progn <br />       (setq O (Geo:MidPoint G H))                               ;GH的中点为圆心，GH为直径做作圆<br />       (setq R (distance O G))                                   ;OG为这个圆的半径<br />       (setq L (distance O C))                                   <br />       (if (>= L R)                                              ;如果可以作切线<br />         (progn <br />           (setq F  (sqrt (* (+ L R) (- L R))))                  ;切线长即为焦距<br />           (setq F1 (polar C a0 (- F)))                          ;左焦点F1<br />           (setq F2 (polar C a0 F))                              ;右焦点F2<br />           (setq F3 (Geo:Mirror2D F1 P a1))                        ;F1关于PD的对称点F3<br />           (setq T1 (inters F2 F3 P D nil))                      ;F2F3与PD的交点为切点<br />           (setq a5 (* (+ (angle T1 F1) (angle T1 F2)) 0.5))     ;角F1T1F2的平分线<br />           (if (equal (rem (- a1 a5) pi) 0 1e-6)                        ;如果平分线与PD重合<br />             nil                                                 ;无解<br />             (setq a (/ (+ (distance F1 T1) (distance F2 T1)) 2) ;否则得到椭圆的长轴长<br />                   b (sqrt (* (- a f) (+ a f)))                  ;由焦距和长轴得到短轴<br />                   s (list C a b a0)                             ;因而得解<br />             )<br />           )<br />         )<br />       )<br />     )<br />   )<br /> )

题7：已知椭圆中心，两共轭轴方向，经过一点和一切线。求此椭圆。

1. ;;;=============================================================
   
2. ;;; Construct an ellipse,the center,the directions of a pair of
   
3. ;;; conjugate diameters,a tangent and a point on it being given.
   
4. ;;; Note: Page 119, Problem 69                                 
   
5. ;;; 功能: 已知椭圆中心，两共轭轴方向，经过一点和一切线。求此椭圆
   
6. ;;; 输入: 中心C,共轭轴方向CD,CE,点P,切线P1P2。                  
   
7. ;;; 输出: 返回椭圆的解集（可能无解或者多解）。                  
   
8. ;;;=============================================================
   
9. (defun ELL:CPT2D (C D E P P1 P2 / A1 A2 F G H J K L1 L2 L3 L4 M N O R S)
   
10.   (if (or (LINE:Colinearity C D E)
    
11.           (LINE:Colinearity C P1 P2)
    
12.           (equal P C 1e-8)
    
13.       )
    
14.     nil
    
15.     (progn
    
16.       (setq M (inters P1 P2 C D nil))
    
17.       (setq N (inters P1 P2 C E nil))
    
18.       (setq L1 (distance C P))
    
19.       (if (and M N)
    
20.         (if (setq F (inters C P M N nil))
    
21.           (if (>= (setq L2 (distance C F)) L1)
    
22.             (progn
    
23.               (setq L3 (sqrt (* (+ L2 L1) (- L2 L1))))
    
24.               (setq O (Geo:MidPoint M N))
    
25.               (setq R (distance O M))
    
26.               (setq a1 (angle F O))
    
27.               (setq a2 (+ a1 (* pi 0.5)))
    
28.               (setq J (polar F a1 L3))
    
29.               (setq K (polar J a2 L1))
    
30.               (setq S nil)
    
31.               (foreach I (CIR:Inters_Circle_Line O R F K)
    
32.                 (setq H (inters I (polar I a2 1) M N nil))
    
33.                 (setq G (polar C a1 (distance H I)))
    
34.                 (setq S (cons (ELL:2J C G H) S))
    
35.               )
    
36.             )
    
37.           )
    
38.           (cond
    
39.             ( (equal L1 (setq R (* 0.5 (distance M N))) 1e-8)
    
40.               (List (ELL:2J C P (Geo:MidPoint M N)))
    
41.             )
    
42.             ( (< L1 R)
    
43.               (setq O (Geo:MidPoint M N))
    
44.               (setq L2 (sqrt (* (+ R L1) (- R L1))))
    
45.               (setq a1 (angle O M))
    
46.               (setq J  (polar O a1 L2))
    
47.               (setq K  (polar O a1 (- L2)))
    
48.               (setq S  nil)
    
49.               (foreach I (list J K)
    
50.                 (setq S (cons (ELL:2J C I P) S))
    
51.               )
    
52.             )
    
53.           )
    
54.         )
    
55.         (progn
    
56.           (and N (setq M N N D D E E N))
    
57.           (if (setq F (inters C P P1 P2 nil))
    
58.             (if (< L1 (setq L2 (distance C F)))
    
59.               (progn
    
60.                 (setq L3 (sqrt (* (+ L2 L1) (- L2 L1))))
    
61.                 (setq L4 (/ (* L1 (distance F M)) L3))
    
62.                 (setq E  (polar C (angle C E) L4))
    
63.                 (list (ELL:2J C E M))
    
64.               )
    
65.             )
    
66.             (list (ELL:2J C P M))
    
67.           )
    
68.         )
    
69.       )
    
70.     )
    
71.   )
    
72. )

;;;=============================================================<br /> ;;; Construct an ellipse,the center,the directions of a pair of <br /> ;;; conjugate diameters,a tangent and a point on it being given.<br /> ;;; Note: Page 119, Problem 69                                  <br /> ;;; 功能: 已知椭圆中心，两共轭轴方向，经过一点和一切线。求此椭圆<br /> ;;; 输入: 中心C,共轭轴方向CD,CE,点P,切线P1P2。                  <br /> ;;; 输出: 返回椭圆的解集（可能无解或者多解）。                  <br /> ;;;=============================================================<br /> (defun ELL:CPT2D (C D E P P1 P2 / A1 A2 F G H J K L1 L2 L3 L4 M N O R S)<br />   (if (or (LINE:Colinearity C D E)<br />           (LINE:Colinearity C P1 P2)<br />           (equal P C 1e-8)<br />       )<br />     nil<br />     (progn<br />       (setq M (inters P1 P2 C D nil))<br />       (setq N (inters P1 P2 C E nil))<br />       (setq L1 (distance C P))<br />       (if (and M N)<br />         (if (setq F (inters C P M N nil))<br />           (if (>= (setq L2 (distance C F)) L1)<br />             (progn<br />               (setq L3 (sqrt (* (+ L2 L1) (- L2 L1))))<br />               (setq O (Geo:MidPoint M N))<br />               (setq R (distance O M))<br />               (setq a1 (angle F O))<br />               (setq a2 (+ a1 (* pi 0.5)))<br />               (setq J (polar F a1 L3))<br />               (setq K (polar J a2 L1))<br />               (setq S nil)<br />               (foreach I (CIR:Inters_Circle_Line O R F K)<br />                 (setq H (inters I (polar I a2 1) M N nil))<br />                 (setq G (polar C a1 (distance H I)))<br />                 (setq S (cons (ELL:2J C G H) S))<br />               )<br />             )<br />           )<br />           (cond<br />             ( (equal L1 (setq R (* 0.5 (distance M N))) 1e-8)<br />               (List (ELL:2J C P (Geo:MidPoint M N)))<br />             )<br />             ( (< L1 R)<br />               (setq O (Geo:MidPoint M N))<br />               (setq L2 (sqrt (* (+ R L1) (- R L1))))<br />               (setq a1 (angle O M))<br />               (setq J  (polar O a1 L2))<br />               (setq K  (polar O a1 (- L2)))<br />               (setq S  nil)<br />               (foreach I (list J K)<br />                 (setq S (cons (ELL:2J C I P) S))<br />               )<br />             )<br />           )<br />         )<br />         (progn<br />           (and N (setq M N N D D E E N))<br />           (if (setq F (inters C P P1 P2 nil))<br />             (if (< L1 (setq L2 (distance C F)))<br />               (progn<br />                 (setq L3 (sqrt (* (+ L2 L1) (- L2 L1))))<br />                 (setq L4 (/ (* L1 (distance F M)) L3))<br />                 (setq E  (polar C (angle C E) L4))<br />                 (list (ELL:2J C E M))<br />               )<br />             )<br />             (list (ELL:2J C P M))<br />           )<br />         )<br />       )<br />     )<br />   )<br /> )

题8：给定椭圆的中心，两切线和其上一点，求此椭圆。

1. ;;;=============================================================
   
2. ;;; Construct an ellipse,the center,two tangents and a point on
   
3. ;;; the curve being given                                       
   
4. ;;; Note: Page 121, Problem 70                                 
   
5. ;;; 功能: 给定椭圆的中心，两切线和其上一点，求此椭圆。         
   
6. ;;; 参数: 中心C, 椭圆上的一点P, 两切线IM, IN（须相交）         
   
7. ;;; 返回: 所求椭圆的解集。                                      
   
8. ;;;=============================================================
   
9. (defun ELL:CP2T (C P I M N / A1 A2 A3 D E F G H L1 L2 L3 O R S)
   
10.   (if (not (setq E (inters C P I N nil)))
    
11.     (setq E N N M M E E (inters C P I N nil))
    
12.   )
    
13.   (setq L1 (distance C P))
    
14.   (setq L2 (distance C E))
    
15.   (if (> L2 L1)
    
16.     (progn
    
17.       (setq L3 (sqrt (* (+ L2 L1) (- L2 L1))))
    
18.       (setq a1 (angle I M))
    
19.       (setq a2 (angle I N))
    
20.       (setq a3 (+ a2 (* pi 0.5)))
    
21.       (setq O  (inters C (polar C a1 1) I N nil))
    
22.       (setq F  (polar E a2 L3))
    
23.       (setq G  (polar F a3 L1))
    
24.       (setq R  (distance O I))
    
25.       (foreach K (CIR:Inters_Circle_Line O R G E)
    
26.         (setq H (inters K (polar K a3 1) I N nil))
    
27.         (setq D (polar C a2 (distance K H)))
    
28.         (setq s (cons (ELL:2J C H D) s))
    
29.       )      
    
30.     )
    
31.   )
    
32. )

;;;=============================================================<br /> ;;; Construct an ellipse,the center,two tangents and a point on <br /> ;;; the curve being given                                       <br /> ;;; Note: Page 121, Problem 70                                  <br /> ;;; 功能: 给定椭圆的中心，两切线和其上一点，求此椭圆。          <br /> ;;; 参数: 中心C, 椭圆上的一点P, 两切线IM, IN（须相交）          <br /> ;;; 返回: 所求椭圆的解集。                                      <br /> ;;;=============================================================<br /> (defun ELL:CP2T (C P I M N / A1 A2 A3 D E F G H L1 L2 L3 O R S)<br />   (if (not (setq E (inters C P I N nil)))<br />     (setq E N N M M E E (inters C P I N nil))<br />   )<br />   (setq L1 (distance C P))<br />   (setq L2 (distance C E))<br />   (if (> L2 L1)<br />     (progn<br />       (setq L3 (sqrt (* (+ L2 L1) (- L2 L1))))<br />       (setq a1 (angle I M))<br />       (setq a2 (angle I N))<br />       (setq a3 (+ a2 (* pi 0.5)))<br />       (setq O  (inters C (polar C a1 1) I N nil))<br />       (setq F  (polar E a2 L3))<br />       (setq G  (polar F a3 L1))<br />       (setq R  (distance O I))<br />       (foreach K (CIR:Inters_Circle_Line O R G E)<br />         (setq H (inters K (polar K a3 1) I N nil))<br />         (setq D (polar C a2 (distance K H)))<br />         (setq s (cons (ELL:2J C H D) s))<br />       )       <br />     )<br />   )<br /> )

题9：给定椭圆的中心，一切线和椭圆上两点，求此椭圆。  

1. ;;;=============================================================
   
2. ;;; Construct an ellipse, the center, two points on curve and a
   
3. ;;; tangent being given                                         
   
4. ;;; Note: Page 123, Problem 72                                 
   
5. ;;; 功能: 给定椭圆的中心，一切线和椭圆上两点，求此椭圆。         
   
6. ;;; 参数: 中心C, 椭圆上的两点A,B, 一切线PQ。                    
   
7. ;;; 返回: 所求椭圆的解集。                                      
   
8. ;;;=============================================================
   
9. (defun ELL:CT2P (C A B P Q / d e)
   
10.   (setq D (GEO:MidPoint A B))
    
11.   (setq E (inters C (polar C (angle A B) 1) P Q nil))
    
12.   (ELL:CPT2D C D E A P Q)
    
13. )

;;;=============================================================<br /> ;;; Construct an ellipse, the center, two points on curve and a <br /> ;;; tangent being given                                         <br /> ;;; Note: Page 123, Problem 72                                  <br /> ;;; 功能: 给定椭圆的中心，一切线和椭圆上两点，求此椭圆。          <br /> ;;; 参数: 中心C, 椭圆上的两点A,B, 一切线PQ。                    <br /> ;;; 返回: 所求椭圆的解集。                                      <br /> ;;;=============================================================<br /> (defun ELL:CT2P (C A B P Q / d e)<br />   (setq D (GEO:MidPoint A B))<br />   (setq E (inters C (polar C (angle A B) 1) P Q nil))<br />   (ELL:CPT2D C D E A P Q)<br /> )

题10: 给定椭圆的中心和三切线，求此椭圆。

1. ;;;=============================================================
   
2. ;;; Construct an ellipse, the center, three tangents being given
   
3. ;;; Note: Page 122, Problem 71                                 
   
4. ;;; 功能: 给定椭圆的中心和三切线，求此椭圆。                    
   
5. ;;; 参数: 中心C, 三切线DE,EF,FD（应两两相交）。                 
   
6. ;;; 返回: 所求椭圆。                                            
   
7. ;;;=============================================================
   
8. (defun ELL:C3T (C D E F / A B D1 D2 D3 G H I J K L1 L2 L3 P Q U W X Y)
   
9.   (setq d1 (distance C D))
   
10.   (setq d2 (distance C E))
    
11.   (setq d3 (distance C F))
    
12.   (setq l3 (distance D E))
    
13.   (setq l2 (distance D F))
    
14.   (setq l1 (distance E F))
    
15. 
    
16.   (if (and (TRI:Is** l1 l2 l3)
    
17.            (TRI:Is** d1 d2 l3)
    
18.            (TRI:Is** d2 d3 l1)
    
19.            (TRI:Is** d3 d1 l2)
    
20.       )
    
21.     (progn
    
22.       (setq X (inters (GEO:scale2 C D) (GEO:scale2 C F) D E nil))
    
23.       (setq Y (GEO:Scale2 C X))
    
24.       (setq G (inters Y (polar Y (angle C E) 1) E F nil))
    
25.       (setq H (inters X (polar X (angle C F) 1) E F nil))
    
26.       (setq I (inters X G Y H nil))
    
27.       (setq J (inters I D E F nil))
    
28.       (setq K (inters J (polar J (angle X G) 1) D E nil))
    
29.       (setq A (angle C X))
    
30.       (setq B (angle C D))
    
31.       (setq P (inters K (polar K B 1) X Y nil))
    
32.       (setq Q (inters K (polar K A 1) C D nil))
    
33.       (setq D1 (distance C P))
    
34.       (setq D2 (distance C X))
    
35.       (setq L1 (distance C Q))
    
36.       (setq L2 (distance C D))
    
37.       (if (and (< D1 D2) (< L1 L2))
    
38.         (progn
    
39.           (setq U (polar C A (sqrt (* D1 D2))))
    
40.           (setq W (polar C B (sqrt (* L1 L2))))
    
41.           (ELL:2J C U W)
    
42.         )
    
43.       )
    
44.     )
    
45.   )
    
46. )

;;;=============================================================<br /> ;;; Construct an ellipse, the center, three tangents being given<br /> ;;; Note: Page 122, Problem 71                                  <br /> ;;; 功能: 给定椭圆的中心和三切线，求此椭圆。                    <br /> ;;; 参数: 中心C, 三切线DE,EF,FD（应两两相交）。                 <br /> ;;; 返回: 所求椭圆。                                            <br /> ;;;=============================================================<br /> (defun ELL:C3T (C D E F / A B D1 D2 D3 G H I J K L1 L2 L3 P Q U W X Y)<br />   (setq d1 (distance C D))<br />   (setq d2 (distance C E))<br />   (setq d3 (distance C F))<br />   (setq l3 (distance D E))<br />   (setq l2 (distance D F))<br />   (setq l1 (distance E F))<br /> <br />   (if (and (TRI:Is** l1 l2 l3)<br />            (TRI:Is** d1 d2 l3)<br />            (TRI:Is** d2 d3 l1)<br />            (TRI:Is** d3 d1 l2)<br />       )<br />     (progn<br />       (setq X (inters (GEO:scale2 C D) (GEO:scale2 C F) D E nil))<br />       (setq Y (GEO:Scale2 C X))<br />       (setq G (inters Y (polar Y (angle C E) 1) E F nil))<br />       (setq H (inters X (polar X (angle C F) 1) E F nil))<br />       (setq I (inters X G Y H nil))<br />       (setq J (inters I D E F nil))<br />       (setq K (inters J (polar J (angle X G) 1) D E nil))<br />       (setq A (angle C X))<br />       (setq B (angle C D))<br />       (setq P (inters K (polar K B 1) X Y nil))<br />       (setq Q (inters K (polar K A 1) C D nil))<br />       (setq D1 (distance C P))<br />       (setq D2 (distance C X))<br />       (setq L1 (distance C Q))<br />       (setq L2 (distance C D))<br />       (if (and (< D1 D2) (< L1 L2))<br />         (progn <br />           (setq U (polar C A (sqrt (* D1 D2))))<br />           (setq W (polar C B (sqrt (* L1 L2))))<br />           (ELL:2J C U W)<br />         )<br />       )<br />     )<br />   )<br /> )

题11：根据中心和椭圆上的三点画这个椭圆。

此题准备了几种方法，两种计算法，一种作图法。下面贴出一计算法代码：

1. ;;;=============================================================
   
2. ;;;highflybird  2012.5.29 创作于深圳 2013.5.5 修改于深圳        
   
3. ;;;-------------------------------------------------------------
   
4. ;;;功能：根据中心和椭圆上的三点画这个椭圆                       
   
5. ;;;参数：中心点，和其他三点                                    
   
6. ;;;返回：中心点，半长轴值、半短轴、旋转角                       
   
7. ;;;=============================================================
   
8. (defun ELL:C3P (Cen p1 p2 p3 / a b c abc ac bb aX bY an I J PT1 PT2 PT3 SS)
   
9.   (setq p1 (mapcar '- p1 cen))
   
10.   (setq p2 (mapcar '- p2 cen))
    
11.   (setq p3 (mapcar '- p3 cen))
    
12.   (setq abc (Mat:3VLE (* (car  p1) (car  p1))
    
13.                       (* (car  p1) (cadr p1))
    
14.                       (* (cadr p1) (cadr p1))
    
15.                       (* (car  p2) (car  p2))
    
16.                       (* (car  p2) (cadr p2))
    
17.                       (* (cadr p2) (cadr p2))
    
18.                       (* (car  p3) (car  p3))
    
19.                       (* (car  p3) (cadr p3))
    
20.                       (* (cadr p3) (cadr p3))
    
21.                       1. 1. 1.
    
22.             )
    
23.   )
    
24.   (if abc
    
25.     (progn
    
26.       (setq a  (car   abc))
    
27.       (setq b  (cadr  abc))
    
28.       (setq c  (caddr abc))
    
29.       (setq b  (/ b 2))
    
30.       (setq bb (* b b))
    
31.       (setq ac (* a c))
    
32.       (setq I  (+ a c))
    
33.       (setq J  (- a c))
    
34.       (setq ss (sqrt (+ (* J J) (* 4 bb))))
    
35.       (if (> I ss)
    
36.         (progn
    
37.           (setq aX (sqrt (/ 2 (- I ss))))
    
38.           (setq bY (sqrt (/ 2 (+ I ss))))
    
39.           (if (equal (/ J I) 0 1e-16)
    
40.             (setq an (* (atan b 0) 0.5))
    
41.             (setq an (* (atan (/ (+ b b) J)) 0.5))
    
42.           )
    
43.           (and (> a c) (setq an (+ an (* pi 0.5))))
    
44.           (list cen aX bY an)                                   ;返回中心，半长轴，半短轴，旋转角度
    
45.         )
    
46.       )
    
47.     )
    
48.   )
    
49. )

;;;=============================================================<br /> ;;;highflybird  2012.5.29 创作于深圳 2013.5.5 修改于深圳        <br /> ;;;-------------------------------------------------------------<br /> ;;;功能：根据中心和椭圆上的三点画这个椭圆                       <br /> ;;;参数：中心点，和其他三点                                     <br /> ;;;返回：中心点，半长轴值、半短轴、旋转角                       <br /> ;;;=============================================================<br /> (defun ELL:C3P (Cen p1 p2 p3 / a b c abc ac bb aX bY an I J PT1 PT2 PT3 SS)<br />   (setq p1 (mapcar '- p1 cen))<br />   (setq p2 (mapcar '- p2 cen))<br />   (setq p3 (mapcar '- p3 cen))<br />   (setq abc (Mat:3VLE (* (car  p1) (car  p1))<br />                       (* (car  p1) (cadr p1))<br />                       (* (cadr p1) (cadr p1))<br />                       (* (car  p2) (car  p2))<br />                       (* (car  p2) (cadr p2))<br />                       (* (cadr p2) (cadr p2))<br />                       (* (car  p3) (car  p3))<br />                       (* (car  p3) (cadr p3))<br />                       (* (cadr p3) (cadr p3))<br />                       1. 1. 1.<br />             )<br />   )<br />   (if abc<br />     (progn<br />       (setq a  (car   abc))<br />       (setq b  (cadr  abc))<br />       (setq c  (caddr abc))<br />       (setq b  (/ b 2))<br />       (setq bb (* b b))<br />       (setq ac (* a c))<br />       (setq I  (+ a c))<br />       (setq J  (- a c))<br />       (setq ss (sqrt (+ (* J J) (* 4 bb))))<br />       (if (> I ss)<br />         (progn<br />           (setq aX (sqrt (/ 2 (- I ss))))<br />           (setq bY (sqrt (/ 2 (+ I ss))))<br />           (if (equal (/ J I) 0 1e-16)<br />             (setq an (* (atan b 0) 0.5))<br />             (setq an (* (atan (/ (+ b b) J)) 0.5))<br />           )<br />           (and (> a c) (setq an (+ an (* pi 0.5))))<br />           (list cen aX bY an)                                   ;返回中心，半长轴，半短轴，旋转角度<br />         )<br />       )<br />     )<br />   )<br /> )

题12：根据椭圆上的四点画水平(或者垂直)方向椭圆。

1. ;;;=============================================================
   
2. ;;;highflybird  2012.5.29 创作于深圳 2013.5.5 修改于深圳        
   
3. ;;;-------------------------------------------------------------
   
4. ;;;功能：根据椭圆上的四点画水平(或者垂直)方向椭圆               
   
5. ;;;参数：四个给定的二位或者三维点                              
   
6. ;;;返回：中心点，半长轴值、半短轴、旋转角                       
   
7. ;;;=============================================================
   
8. (defun ELL:4P (p0 p1 p2 p3 / A B C D K M N O X1 X2 X3 Y1 Y2 Y3 U1 U2 U3 W1 W2 W3)
   
9.   (setq p1 (mapcar '- p1 p0)
   
10.         p2 (mapcar '- p2 p0)
    
11.         p3 (mapcar '- p3 p0)
    
12.         x1 (car  p1)
    
13.         y1 (cadr p1)
    
14.         x2 (car  p2)
    
15.         y2 (cadr p2)
    
16.         x3 (car  p3)
    
17.         y3 (cadr p3)
    
18.         U1 (* x1 x1)
    
19.         W1 (* y1 y1)
    
20.         U2 (* x2 x2)
    
21.         W2 (* y2 y2)
    
22.         U3 (* x3 x3)
    
23.         W3 (* y3 y3)
    
24.         A  (MAT:Det3 W1 x1 y1 W2 x2 y2 W3 x3 y3)
    
25.         B  (MAT:Det3 U1 x1 y1 U2 x2 y2 U3 x3 y3)
    
26.         C  (MAT:Det3 U1 W1 y1 U2 W2 y2 U3 W3 y3)
    
27.         D  (MAT:Det3 U1 W1 x1 U2 W2 x2 U3 W3 x3)
    
28.         B  (- B)
    
29.         D  (- D)
    
30.   )
    
31.   (if (or (and (> A 0) (> B 0)) (and (< A 0) (< B 0)))
    
32.     (progn
    
33.       (setq K (+ (/ (* C C) 4 A) (/ (* D D) 4 B)))
    
34.       (setq m (sqrt (/ K A)))
    
35.       (setq n (sqrt (/ K B)))
    
36.       (setq O (list (/ C A -2) (/ D B -2) 0))
    
37.       (setq O (mapcar '+ O P0))
    
38.       (if (/= m 0.0 n 0.0)
    
39.         (if (> n m)
    
40.           (list O n m (/ pi 2))                                 ;返回中心，半长轴，半短轴，旋转角度90度
    
41.           (list O m n 0.0)                                      ;返回中心，半长轴，半短轴，旋转角度0度
    
42.         )
    
43.       )        
    
44.     )
    
45.   )
    
46. )

;;;=============================================================<br /> ;;;highflybird  2012.5.29 创作于深圳 2013.5.5 修改于深圳        <br /> ;;;-------------------------------------------------------------<br /> ;;;功能：根据椭圆上的四点画水平(或者垂直)方向椭圆               <br /> ;;;参数：四个给定的二位或者三维点                               <br /> ;;;返回：中心点，半长轴值、半短轴、旋转角                       <br /> ;;;=============================================================<br /> (defun ELL:4P (p0 p1 p2 p3 / A B C D K M N O X1 X2 X3 Y1 Y2 Y3 U1 U2 U3 W1 W2 W3)<br />   (setq p1 (mapcar '- p1 p0)<br />         p2 (mapcar '- p2 p0)<br />         p3 (mapcar '- p3 p0)<br />         x1 (car  p1)<br />         y1 (cadr p1)<br />         x2 (car  p2)<br />         y2 (cadr p2)<br />         x3 (car  p3)<br />         y3 (cadr p3)<br />         U1 (* x1 x1)<br />         W1 (* y1 y1)<br />         U2 (* x2 x2)<br />         W2 (* y2 y2)<br />         U3 (* x3 x3)<br />         W3 (* y3 y3)<br />         A  (MAT:Det3 W1 x1 y1 W2 x2 y2 W3 x3 y3)<br />         B  (MAT:Det3 U1 x1 y1 U2 x2 y2 U3 x3 y3)<br />         C  (MAT:Det3 U1 W1 y1 U2 W2 y2 U3 W3 y3)<br />         D  (MAT:Det3 U1 W1 x1 U2 W2 x2 U3 W3 x3)<br />         B  (- B)<br />         D  (- D)<br />   )<br />   (if (or (and (> A 0) (> B 0)) (and (< A 0) (< B 0)))<br />     (progn<br />       (setq K (+ (/ (* C C) 4 A) (/ (* D D) 4 B)))<br />       (setq m (sqrt (/ K A)))<br />       (setq n (sqrt (/ K B)))<br />       (setq O (list (/ C A -2) (/ D B -2) 0))<br />       (setq O (mapcar '+ O P0))<br />       (if (/= m 0.0 n 0.0)<br />         (if (> n m)<br />           (list O n m (/ pi 2))                                 ;返回中心，半长轴，半短轴，旋转角度90度<br />           (list O m n 0.0)                                      ;返回中心，半长轴，半短轴，旋转角度0度<br />         )<br />       )        <br />     )<br />   )<br /> )

题13：已知椭圆两焦点及其一点，求此椭圆。

1. ;;;=============================================================
   
2. ;;; To describe an ellipse, the foci and a point on the curve   
   
3. ;;; being given. Ref: Page 125, Problem 74                     
   
4. ;;; 功能: 已知椭圆两焦点及其一点，求此椭圆                     
   
5. ;;; 输入: 两焦点E,F 和经过一点P。                              
   
6. ;;; 输出: 椭圆的解。                                            
   
7. ;;;=============================================================
   
8. (defun ELL:P2F (E F P / o a b c)
   
9.   (setq O (GEO:MidPoint E F))
   
10.   (setq c (distance O F))
    
11.   (setq a (* 0.5 (+ (distance E P) (distance F P))))
    
12.   (setq b (sqrt (* (+ a c) (- a c))))
    
13.   (list O a b (angle E F))
    
14. )

;;;=============================================================<br /> ;;; To describe an ellipse, the foci and a point on the curve   <br /> ;;; being given. Ref: Page 125, Problem 74                      <br /> ;;; 功能: 已知椭圆两焦点及其一点，求此椭圆                      <br /> ;;; 输入: 两焦点E,F 和经过一点P。                               <br /> ;;; 输出: 椭圆的解。                                            <br /> ;;;=============================================================<br /> (defun ELL:P2F (E F P / o a b c)<br />   (setq O (GEO:MidPoint E F))<br />   (setq c (distance O F))<br />   (setq a (* 0.5 (+ (distance E P) (distance F P))))<br />   (setq b (sqrt (* (+ a c) (- a c))))<br />   (list O a b (angle E F))<br /> )

题14：已知椭圆两焦点及一切线，求此椭圆。   

1. ;;;=============================================================
   
2. ;;; To describe an ellipse, the foci and a tangent to the curve
   
3. ;;; being given. Ref: Page 125, Problem 75                     
   
4. ;;; 功能: 已知椭圆两焦点及一切线，求此椭圆                     
   
5. ;;; 输入: 两焦点E,F 和一点切线PQ。                              
   
6. ;;; 输出: 椭圆的解。                                            
   
7. ;;;=============================================================
   
8. (defun ELL:T2F (E F P Q / G H I)
   
9.   (setq I (inters P Q E F nil))
   
10.   (if (and I (equal (angle E I) (angle I F) 1e-8))
    
11.     nil
    
12.     (progn
    
13.       (setq G (GEO:Mirror2D E P (angle P Q)))
    
14.       (setq H (inters P Q F G nil))
    
15.       (ELL:P2F E F H)
    
16.     )
    
17.   )
    
18. )

;;;=============================================================<br /> ;;; To describe an ellipse, the foci and a tangent to the curve <br /> ;;; being given. Ref: Page 125, Problem 75                      <br /> ;;; 功能: 已知椭圆两焦点及一切线，求此椭圆                      <br /> ;;; 输入: 两焦点E,F 和一点切线PQ。                              <br /> ;;; 输出: 椭圆的解。                                            <br /> ;;;=============================================================<br /> (defun ELL:T2F (E F P Q / G H I)<br />   (setq I (inters P Q E F nil))<br />   (if (and I (equal (angle E I) (angle I F) 1e-8))<br />     nil<br />     (progn <br />       (setq G (GEO:Mirror2D E P (angle P Q)))<br />       (setq H (inters P Q F G nil))<br />       (ELL:P2F E F H)<br />     )<br />   )<br /> )

题15：已知椭圆一焦点及一切线切点和椭圆上一点，求此椭圆。

1. ;;;=============================================================
   
2. ;;; To describe an ellipse, a focus, a tangent with its point of
   
3. ;;; contact and second point on the curve being given           
   
4. ;;; Note: Page 126, Problem 76                                 
   
5. ;;; 功能: 已知椭圆一焦点及一切线切点和椭圆上一点，求此椭圆      
   
6. ;;; 输入: 焦点F,点P 和切线RS（R为切点）。                       
   
7. ;;; 输出: 椭圆的解。                                            
   
8. ;;;=============================================================
   
9. (defun ELL:FPT (F P R S / G H M J E)
   
10.   (if (LINE:IsSameSide F P R S)
    
11.     (progn
    
12.       (setq G (GEO:Mirror2D F R (angle R S)))
    
13.       (setq H (polar G (angle G R) (distance F P)))
    
14.       (setq M (GEO:MidPoint H P))
    
15.       (setq J (polar M (+ (angle H P) (* pi 0.5)) 1))
    
16.       (setq E (inters M J R G nil))
    
17.       (if (LINE:IsSameSide E F R S)
    
18.         (ELL:P2F E F P)
    
19.       )
    
20.     )
    
21.   )
    
22. )

;;;=============================================================<br /> ;;; To describe an ellipse, a focus, a tangent with its point of<br /> ;;; contact and second point on the curve being given           <br /> ;;; Note: Page 126, Problem 76                                  <br /> ;;; 功能: 已知椭圆一焦点及一切线切点和椭圆上一点，求此椭圆      <br /> ;;; 输入: 焦点F,点P 和切线RS（R为切点）。                       <br /> ;;; 输出: 椭圆的解。                                            <br /> ;;;=============================================================<br /> (defun ELL:FPT (F P R S / G H M J E)<br />   (if (LINE:IsSameSide F P R S)<br />     (progn <br />       (setq G (GEO:Mirror2D F R (angle R S)))<br />       (setq H (polar G (angle G R) (distance F P)))<br />       (setq M (GEO:MidPoint H P))<br />       (setq J (polar M (+ (angle H P) (* pi 0.5)) 1))<br />       (setq E (inters M J R G nil))<br />       (if (LINE:IsSameSide E F R S)<br />         (ELL:P2F E F P)<br />       )<br />     )<br />   )<br /> )

题16：已知椭圆一焦点及一切线和椭圆上两点，求此椭圆。

1. ;;;=============================================================
   
2. ;;; To describe an ellipse, a focus, a tangent and two points on
   
3. ;;; the curve being given.                                      
   
4. ;;; Note: Page 127, Problem 77                                 
   
5. ;;; 功能: 已知椭圆一焦点及一切线和椭圆上两点，求此椭圆         
   
6. ;;; 输入: 焦点F,点P,Q 和切线MN。                                
   
7. ;;; 输出: 椭圆的解集。                                          
   
8. ;;;=============================================================
   
9. (defun ELL:FT2P (F M N P Q / d1 d2 d3 d4 d5 E O S X)
   
10.   (if (and (LINE:IsSameSide F P M N) (LINE:IsSameSide F Q M N))
    
11.     (progn
    
12.       (setq E (GEO:Mirror2D F M (angle M N)))
    
13.       (setq d1 (distance F P))
    
14.       (setq d2 (distance F Q))
    
15.       (if (equal d1 d2 1e-8)
    
16.         (setq X (CIR:PPC P Q E d1))
    
17.         (if (> d1 d2)
    
18.           (setq X (CIR:PCC P Q (- d1 d2) E d1))
    
19.           (setq X (CIR:PCC Q P (- d2 d1) E d2))
    
20.         )
    
21.       )
    
22.       (foreach v X
    
23.         (setq O  (car v))
    
24.         (setq d3 (distance O E))
    
25.         (setq d4 (+ d1 (distance O P)))
    
26.         (setq d5 (+ d2 (distance O Q)))
    
27.         (if (and (equal d3 d4 1e-8) (equal d3 d5 1e-8))
    
28.           (setq s (cons (ELL:P2F O F P) s))
    
29.         )
    
30.       )
    
31.       (reverse S)
    
32.     )
    
33.   )
    
34. )

;;;=============================================================<br /> ;;; To describe an ellipse, a focus, a tangent and two points on<br /> ;;; the curve being given.                                      <br /> ;;; Note: Page 127, Problem 77                                  <br /> ;;; 功能: 已知椭圆一焦点及一切线和椭圆上两点，求此椭圆          <br /> ;;; 输入: 焦点F,点P,Q 和切线MN。                                <br /> ;;; 输出: 椭圆的解集。                                          <br /> ;;;=============================================================<br /> (defun ELL:FT2P (F M N P Q / d1 d2 d3 d4 d5 E O S X)<br />   (if (and (LINE:IsSameSide F P M N) (LINE:IsSameSide F Q M N))<br />     (progn<br />       (setq E (GEO:Mirror2D F M (angle M N)))<br />       (setq d1 (distance F P))<br />       (setq d2 (distance F Q))<br />       (if (equal d1 d2 1e-8)<br />         (setq X (CIR:PPC P Q E d1))<br />         (if (> d1 d2)<br />           (setq X (CIR:PCC P Q (- d1 d2) E d1))<br />           (setq X (CIR:PCC Q P (- d2 d1) E d2))<br />         )<br />       )<br />       (foreach v X<br />         (setq O  (car v))<br />         (setq d3 (distance O E))<br />         (setq d4 (+ d1 (distance O P)))<br />         (setq d5 (+ d2 (distance O Q)))<br />         (if (and (equal d3 d4 1e-8) (equal d3 d5 1e-8))<br />           (setq s (cons (ELL:P2F O F P) s))<br />         )<br />       )<br />       (reverse S)<br />     )<br />   ) <br /> )

题17：已知椭圆一焦点及两条切线和椭圆上一点，求此椭圆。

1. ;;;=============================================================
   
2. ;;; Construct an ellipse, a focus, a point on the curve and two
   
3. ;;; tangents being given                                       
   
4. ;;; Note: Page 127, Problem 78                                 
   
5. ;;; 功能: 已知椭圆一焦点及两条切线和椭圆上一点，求此椭圆        
   
6. ;;; 输入: 焦点F,点P 和两条切线L1L2,L3L4。                       
   
7. ;;; 输出: 椭圆的解集。                                          
   
8. ;;;=============================================================
   
9. (defun ELL:FP2T (F P L1 L2 L3 L4 / D1 D2 D3 E G H R s)
   
10.   (setq G (GEO:Mirror2D F L1 (angle L1 L2)))
    
11.   (setq H (GEO:Mirror2D F L3 (angle L3 L4)))
    
12.   (setq S nil)
    
13.   (setq R (distance P F))
    
14.   (foreach n (CIR:PPC G H P R)
    
15.     (setq E (car n))
    
16.     (setq d1 (distance E G))
    
17.     (setq d2 (distance E H))
    
18.     (setq d3 (+ R (distance E P)))
    
19.     (if (and (equal d1 d2 1e-6) (equal d2 d3 1e-6))
    
20.       (setq s (cons (ELL:P2F E F P) s))
    
21.     )
    
22.   )
    
23.   S
    
24. )

;;;=============================================================<br /> ;;; Construct an ellipse, a focus, a point on the curve and two <br /> ;;; tangents being given                                        <br /> ;;; Note: Page 127, Problem 78                                  <br /> ;;; 功能: 已知椭圆一焦点及两条切线和椭圆上一点，求此椭圆        <br /> ;;; 输入: 焦点F,点P 和两条切线L1L2,L3L4。                       <br /> ;;; 输出: 椭圆的解集。                                          <br /> ;;;=============================================================<br /> (defun ELL:FP2T (F P L1 L2 L3 L4 / D1 D2 D3 E G H R s)<br />   (setq G (GEO:Mirror2D F L1 (angle L1 L2)))<br />   (setq H (GEO:Mirror2D F L3 (angle L3 L4)))<br />   (setq S nil)<br />   (setq R (distance P F))<br />   (foreach n (CIR:PPC G H P R)<br />     (setq E (car n))<br />     (setq d1 (distance E G))<br />     (setq d2 (distance E H))<br />     (setq d3 (+ R (distance E P)))<br />     (if (and (equal d1 d2 1e-6) (equal d2 d3 1e-6))<br />       (setq s (cons (ELL:P2F E F P) s))<br />     )<br />   )<br />   S<br /> )

题18：已知椭圆一焦点及三条切线，求此椭圆。

1. ;;;=============================================================
   
2. ;;; Construct an ellipse, a focus and three tangents being given
   
3. ;;; Note: Page 129, Problem 79                                 
   
4. ;;; 功能: 已知椭圆一焦点及三条切线，求此椭圆                    
   
5. ;;; 输入: 焦点F,三切线L1L2,L3L4,L5L6。                          
   
6. ;;; 输出: 椭圆的解集。                                          
   
7. ;;;=============================================================
   
8. (defun ELL:F3T (F L1 L2 L3 L4 L5 L6 / E G H I)
   
9.   (setq G (GEO:Mirror2D F L1 (angle L1 L2)))
   
10.   (setq H (GEO:Mirror2D F L3 (angle L3 L4)))
    
11.   (setq I (GEO:Mirror2D F L5 (angle L5 L6)))
    
12.   (if (setq E (car (TRI:CircumCenter G H I)))
    
13.     (if (and (LINE:IsSameSide E F L1 L2)
    
14.              (LINE:IsSameSide E F L3 L4)
    
15.              (LINE:IsSameSide E F L5 L6)
    
16.         )
    
17.       (ELL:P2F E F (inters E G L1 L2 nil))
    
18.     )
    
19.   )
    
20. )

;;;=============================================================<br /> ;;; Construct an ellipse, a focus and three tangents being given<br /> ;;; Note: Page 129, Problem 79                                  <br /> ;;; 功能: 已知椭圆一焦点及三条切线，求此椭圆                    <br /> ;;; 输入: 焦点F,三切线L1L2,L3L4,L5L6。                          <br /> ;;; 输出: 椭圆的解集。                                          <br /> ;;;=============================================================<br /> (defun ELL:F3T (F L1 L2 L3 L4 L5 L6 / E G H I)<br />   (setq G (GEO:Mirror2D F L1 (angle L1 L2)))<br />   (setq H (GEO:Mirror2D F L3 (angle L3 L4)))<br />   (setq I (GEO:Mirror2D F L5 (angle L5 L6)))<br />   (if (setq E (car (TRI:CircumCenter G H I)))<br />     (if (and (LINE:IsSameSide E F L1 L2)<br />              (LINE:IsSameSide E F L3 L4)<br />              (LINE:IsSameSide E F L5 L6)<br />         )<br />       (ELL:P2F E F (inters E G L1 L2 nil))<br />     )<br />   )<br /> )

题19：已知椭圆一焦点及其上三点，求此椭圆。
  

1. ;;;=============================================================
   
2. ;;; Construct an ellipse, a focus and three points being given  
   
3. ;;; Note: Page 129, Problem 80                                 
   
4. ;;; 功能: 已知椭圆一焦点及其上三点，求此椭圆                    
   
5. ;;; 输入: 焦点F,经过三点I,J,K.                                 
   
6. ;;; 输出: 椭圆的解集。                                          
   
7. ;;;=============================================================
   
8. (defun ELL:F3P (F I J K / a1 a2 a3 b1 b2 b3 p1 p2 p3 M N Pt)
   
9.   (setq a1 (angle F I))
   
10.   (setq A2 (angle F J))
    
11.   (setq A3 (angle F K))
    
12.   (setq b1 (* 0.5 (+ a1 a2)))
    
13.   (setq b2 (* 0.5 (+ a2 a3)))
    
14.   (setq b3 (* 0.5 (+ a3 a1)))
    
15.   (setq p1 (polar F b1 pi))
    
16.   (setq p2 (polar F b2 pi))
    
17.   (setq P3 (polar F b3 pi))
    
18.   (setq M  (inters I P3 F P1 nil))
    
19.   (setq N  (inters K P3 F P2 nil))
    
20.   (setq Pt (inters M N I K nil))
    
21.   (and (null pt) (setq Pt (polar J (angle I K) Pi)))
    
22.   (setq M  (inters Pt J F P1 nil))
    
23.   (setq N  (inters Pt J F P2 nil))
    
24.   (ELL:F3T F I M Pt J N K)
    
25. )

;;;=============================================================<br /> ;;; Construct an ellipse, a focus and three points being given  <br /> ;;; Note: Page 129, Problem 80                                  <br /> ;;; 功能: 已知椭圆一焦点及其上三点，求此椭圆                    <br /> ;;; 输入: 焦点F,经过三点I,J,K.                                  <br /> ;;; 输出: 椭圆的解集。                                          <br /> ;;;=============================================================<br /> (defun ELL:F3P (F I J K / a1 a2 a3 b1 b2 b3 p1 p2 p3 M N Pt)<br />   (setq a1 (angle F I))<br />   (setq A2 (angle F J))<br />   (setq A3 (angle F K))<br />   (setq b1 (* 0.5 (+ a1 a2)))<br />   (setq b2 (* 0.5 (+ a2 a3)))<br />   (setq b3 (* 0.5 (+ a3 a1)))<br />   (setq p1 (polar F b1 pi))<br />   (setq p2 (polar F b2 pi))<br />   (setq P3 (polar F b3 pi))<br />   (setq M  (inters I P3 F P1 nil))<br />   (setq N  (inters K P3 F P2 nil))<br />   (setq Pt (inters M N I K nil))<br />   (and (null pt) (setq Pt (polar J (angle I K) Pi)))<br />   (setq M  (inters Pt J F P1 nil))<br />   (setq N  (inters Pt J F P2 nil))<br />   (ELL:F3T F I M Pt J N K)<br /> )

题20：已知椭圆两切线及其切点和椭圆上第三点，求此椭圆。

1. ;;;=============================================================
   
2. ;;; Construct an ellipse,2 tangents with their points of contact
   
3. ;;; and a third point being given                              
   
4. ;;; Note: Page 131, Problem 81                                 
   
5. ;;; 功能: 已知椭圆两切线及其切点和椭圆上第三点，求此椭圆        
   
6. ;;; 输入: 两切线VQ,VR(Q,R是其切点)和经过第三点P。               
   
7. ;;; 输出: 椭圆的解集。                                          
   
8. ;;;=============================================================
   
9. (defun ELL:P2T (V Q R P / s u w x y m n c)
   
10.   (setq S (inters Q P V R nil))
    
11.   (setq U (inters V Q R P nil))
    
12.   (cond
    
13.     ( (and S U)
    
14.       (setq W (inters U S Q R nil))
    
15.     )
    
16.     ( U
    
17.       (setq W (polar U (angle V R) 1))
    
18.       (setq W (inters U W Q R nil))
    
19.     )
    
20.     ( S
    
21.       (setq W (polar S (angle V Q) 1))
    
22.       (setq W (inters S W Q R nil))
    
23.     )
    
24.     (t
    
25.       (setq W (polar P (angle Q R) 1))
    
26.     )
    
27.   )
    
28.   (setq X (inters P W V R nil))
    
29.   (setq Y (inters P W V Q nil))
    
30.   (setq M (Geo:Midpoint Q R))
    
31.   (setq N (Geo:MidPoint P R))
    
32.   (setq C (inters V M X N nil))
    
33.   (ELL:C3T C V X Y)
    
34. )

;;;=============================================================<br /> ;;; Construct an ellipse,2 tangents with their points of contact<br /> ;;; and a third point being given                               <br /> ;;; Note: Page 131, Problem 81                                  <br /> ;;; 功能: 已知椭圆两切线及其切点和椭圆上第三点，求此椭圆        <br /> ;;; 输入: 两切线VQ,VR(Q,R是其切点)和经过第三点P。               <br /> ;;; 输出: 椭圆的解集。                                          <br /> ;;;=============================================================<br /> (defun ELL:P2T (V Q R P / s u w x y m n c)<br />   (setq S (inters Q P V R nil))<br />   (setq U (inters V Q R P nil))<br />   (cond<br />     ( (and S U)<br />       (setq W (inters U S Q R nil))<br />     )<br />     ( U<br />       (setq W (polar U (angle V R) 1))<br />       (setq W (inters U W Q R nil))<br />     )<br />     ( S<br />       (setq W (polar S (angle V Q) 1))<br />       (setq W (inters S W Q R nil))<br />     )<br />     (t<br />       (setq W (polar P (angle Q R) 1))<br />     )<br />   )<br />   (setq X (inters P W V R nil))<br />   (setq Y (inters P W V Q nil))<br />   (setq M (Geo:Midpoint Q R))<br />   (setq N (Geo:MidPoint P R))<br />   (setq C (inters V M X N nil))<br />   (ELL:C3T C V X Y)<br /> )

题21：已知椭圆两切线和椭圆上三点，求此椭圆。

1. ;;;=============================================================
   
2. ;;; To describe an ellipse,2 tangents and 3 points being given.
   
3. ;;; Note: Page 133, Problem 82                                 
   
4. ;;; 功能: 已知椭圆两切线和椭圆上三点，求此椭圆。               
   
5. ;;; 输入: 两切线T1, T2和椭圆上三点A,B,C。                       
   
6. ;;; 输出: 椭圆的解集。                                          
   
7. ;;;=============================================================
   
8. (defun ELL:2T3P (T1 T2 A B C / p1 p2 q1 q2 p q pts x1 x2 res s)
   
9.   (setq p1 (car  t1))
   
10.   (setq p2 (cadr t1))
    
11.   (setq q1 (car  t2))
    
12.   (setq q2 (cadr t2))
    
13.   (foreach i (list B C)
    
14.     (setq P (inters A i P1 P2 nil))
    
15.     (setq q (inters A i Q1 Q2 nil))
    
16.     (setq pts (cons (cdr (GEO:Cen_Foci A i p q)) pts))
    
17.   )
    
18. 
    
19.   (foreach p (car pts)
    
20.     (foreach q (cadr pts)
    
21.       (setq x1 (inters p q p1 p2 nil))
    
22.       (setq x2 (inters p q q1 q2 nil))
    
23.       (if (and x1 x2)
    
24.         (if (setq s (ELL:5P_1 x1 x2 A B C))
    
25.           (setq res (cons s res))
    
26.         )
    
27.       )
    
28.     )
    
29.   )
    
30.   res
    
31. )

;;;=============================================================<br /> ;;; To describe an ellipse,2 tangents and 3 points being given. <br /> ;;; Note: Page 133, Problem 82                                  <br /> ;;; 功能: 已知椭圆两切线和椭圆上三点，求此椭圆。                <br /> ;;; 输入: 两切线T1, T2和椭圆上三点A,B,C。                       <br /> ;;; 输出: 椭圆的解集。                                          <br /> ;;;=============================================================<br /> (defun ELL:2T3P (T1 T2 A B C / p1 p2 q1 q2 p q pts x1 x2 res s)<br />   (setq p1 (car  t1))<br />   (setq p2 (cadr t1))<br />   (setq q1 (car  t2))<br />   (setq q2 (cadr t2))<br />   (foreach i (list B C)<br />     (setq P (inters A i P1 P2 nil))<br />     (setq q (inters A i Q1 Q2 nil))<br />     (setq pts (cons (cdr (GEO:Cen_Foci A i p q)) pts))<br />   )<br /> <br />   (foreach p (car pts)<br />     (foreach q (cadr pts)<br />       (setq x1 (inters p q p1 p2 nil))<br />       (setq x2 (inters p q q1 q2 nil))<br />       (if (and x1 x2)<br />         (if (setq s (ELL:5P_1 x1 x2 A B C))<br />           (setq res (cons s res))<br />         )<br />       )<br />     )<br />   )<br />   res<br /> )

题22：已知椭圆三切线及和椭圆上两点，求此椭圆。

1. ;;;=============================================================
   
2. ;;; To describe an ellipse,2 tangents and 3 points being given.
   
3. ;;; Note: Page 134, Problem 83                                 
   
4. ;;; 功能: 已知椭圆三切线及和椭圆上两点，求此椭圆。              
   
5. ;;; 输入: 三切线T1,T2,T3和椭圆上的两点A,B。                     
   
6. ;;; 输出: 椭圆的解集。                                          
   
7. ;;;=============================================================
   
8. (defun ELL:2P3T (T1 T2 T3 A B / p1 p2 q1 q2 r1 r2 p q r M N L U V W X Y res s)
   
9.   (setq p1 (car  t1))
   
10.   (setq p2 (cadr t1))
    
11.   (setq q1 (car  t2))
    
12.   (setq q2 (cadr t2))
    
13.   (setq R1 (car  t3))
    
14.   (setq R2 (cadr t3))
    
15.   (setq P  (inters q1 q2 r1 r2 nil))
    
16.   (setq Q  (inters r1 r2 p1 p2 nil))
    
17.   (setq R  (inters p1 p2 q1 q2 nil))
    
18.   
    
19.   (setq M (inters A B R1 R2 nil))
    
20.   (setq N (inters A B P1 P2 nil))
    
21.   (setq L (inters A B Q1 Q2 nil))
    
22. 
    
23. 
    
24.   (foreach D (cdr (GEO:Cen_Foci A B M L))
    
25.     (foreach E (cdr (Geo:Cen_FOci A B M N))
    
26.       (setq V (GEO:MeanPoint M D E))
    
27.       (setq W (inters R V R1 R2 nil))
    
28.       (setq X (inters W D Q1 Q2 nil))
    
29.       (setq Y (inters W E P1 P2 nil))
    
30.       (if (and W X Y)
    
31.         ;;(if (setq S (ELL:P2T Q W X A))
    
32.         (if (setq S (ELL:5P_1 A B W X Y))
    
33.           (setq Res (cons S Res))
    
34.         )
    
35.       )
    
36.     )
    
37.   )
    
38.   (reverse Res)
    
39. )

;;;=============================================================<br /> ;;; To describe an ellipse,2 tangents and 3 points being given. <br /> ;;; Note: Page 134, Problem 83                                  <br /> ;;; 功能: 已知椭圆三切线及和椭圆上两点，求此椭圆。              <br /> ;;; 输入: 三切线T1,T2,T3和椭圆上的两点A,B。                     <br /> ;;; 输出: 椭圆的解集。                                          <br /> ;;;=============================================================<br /> (defun ELL:2P3T (T1 T2 T3 A B / p1 p2 q1 q2 r1 r2 p q r M N L U V W X Y res s)<br />   (setq p1 (car  t1))<br />   (setq p2 (cadr t1))<br />   (setq q1 (car  t2))<br />   (setq q2 (cadr t2))<br />   (setq R1 (car  t3))<br />   (setq R2 (cadr t3))<br />   (setq P  (inters q1 q2 r1 r2 nil))<br />   (setq Q  (inters r1 r2 p1 p2 nil))<br />   (setq R  (inters p1 p2 q1 q2 nil))<br />   <br />   (setq M (inters A B R1 R2 nil))<br />   (setq N (inters A B P1 P2 nil))<br />   (setq L (inters A B Q1 Q2 nil))<br /> <br /> <br />   (foreach D (cdr (GEO:Cen_Foci A B M L))<br />     (foreach E (cdr (Geo:Cen_FOci A B M N))<br />       (setq V (GEO:MeanPoint M D E))<br />       (setq W (inters R V R1 R2 nil))<br />       (setq X (inters W D Q1 Q2 nil))<br />       (setq Y (inters W E P1 P2 nil))<br />       (if (and W X Y)<br />         ;;(if (setq S (ELL:P2T Q W X A))<br />         (if (setq S (ELL:5P_1 A B W X Y))<br />           (setq Res (cons S Res))<br />         )<br />       )<br />     )<br />   )<br />   (reverse Res)<br /> )

题23：已知椭圆五切线，求此椭圆。

1. ;;;=============================================================
   
2. ;;; To describe an ellipse to touch five given lines            
   
3. ;;; Note: Page 135, Problem 84                                 
   
4. ;;; 功能: 已知椭圆五切线，求此椭圆。                           
   
5. ;;; 输入: 五切线T1,T2,T3。                                      
   
6. ;;; 输出: 椭圆的解集。                                          
   
7. ;;;=============================================================
   
8. (defun ELL:5T(A B C D E / L S F P)
   
9.   (setq L (ALG:Graham (list A B C D E)))
   
10.   (if (= (length L) 5)
    
11.     (progn
    
12.       (setq S nil)
    
13.       (setq L (append (cdr L) L))
    
14.       (repeat 5
    
15.         (setq F (inters (car L) (caddr L) (cadr L) (cadddr L) nil))
    
16.         (setq P (inters (cadr L) (caddr L) (nth 4 L) F nil))
    
17.         (setq S (cons P S))
    
18.         (setq L (cdr L))
    
19.       )
    
20.       (apply 'ELL:5P_1 S)
    
21.     )
    
22.   )
    
23. )

;;;=============================================================<br /> ;;; To describe an ellipse to touch five given lines            <br /> ;;; Note: Page 135, Problem 84                                  <br /> ;;; 功能: 已知椭圆五切线，求此椭圆。                            <br /> ;;; 输入: 五切线T1,T2,T3。                                      <br /> ;;; 输出: 椭圆的解集。                                          <br /> ;;;=============================================================<br /> (defun ELL:5T(A B C D E / L S F P)<br />   (setq L (ALG:Graham (list A B C D E)))<br />   (if (= (length L) 5)<br />     (progn<br />       (setq S nil)<br />       (setq L (append (cdr L) L))<br />       (repeat 5<br />         (setq F (inters (car L) (caddr L) (cadr L) (cadddr L) nil))<br />         (setq P (inters (cadr L) (caddr L) (nth 4 L) F nil))<br />         (setq S (cons P S))<br />         (setq L (cdr L))<br />       )<br />       (apply 'ELL:5P_1 S)<br />     )<br />   )<br /> )

题24：已知椭圆四切线及和椭圆上一点，求此椭圆。

1. ;;;=============================================================
   
2. ;;; To describe an ellipse,4 tangents AB,BC,CD,CA and a point E
   
3. ;;; on the curve being given                                    
   
4. ;;; Note: Page 137, Problem 85                                 
   
5. ;;; 功能: 已知椭圆四切线及和椭圆上一点，求此椭圆。              
   
6. ;;; 输入: 四切线AB,BC,CD,DA和椭圆上的一点E。                    
   
7. ;;; 输出: 椭圆的解集。                                          
   
8. ;;;=============================================================
   
9. (defun ELL:P4T (A B C D E / ps B1 C1 P Q X s A0 AN AX D1 D2 F G H I SS)
   
10.   (setq Ps (ALG:Graham (list A B C D)))
    
11.   (if (and (= (length ps) 4) (ALG:Inside-p E ps))
    
12.     (progn
    
13.       (setq A  (car ps) B (cadr ps) C (caddr ps) D (cadddr ps))
    
14.       (setq I  (inters A C B D))
    
15.       (setq an (angle I E))
    
16.       (setq A0 (GEO:Angle1 I an A))
    
17.       (while (setq ps (cdr ps))
    
18.         (setq ax (geo:angle1 I an (car ps)))
    
19.         (if (> ax A0)
    
20.           (setq a0 ax X A A B B C C D D X)
    
21.         )
    
22.       )
    
23.       (setq B1 (inters B E A D nil))
    
24.       (setq C1 (inters C E A D nil))
    
25.       (setq D1 (distance A D))
    
26.       (setq D2 (distance C D))
    
27.       
    
28.       (setq SS (GEO:Cen_Foci A C1 D B1))
    
29.       (setq P  (caddr ss))
    
30.       (setq F  (inters P E C D nil))
    
31.       (if (setq X (ELL:5T A B C F P))
    
32.         (setq s (cons X s))
    
33.       )
    
34.       (setq Q (cadr ss))
    
35.       (setq G (inters Q E C D nil))
    
36.       (setq H (inters Q E B C nil))
    
37.       (if (setq x (Ell:5T A B H G D))
    
38.         (setq s (cons X s))
    
39.       )
    
40.     )
    
41.   )
    
42. )

;;;=============================================================<br /> ;;; To describe an ellipse,4 tangents AB,BC,CD,CA and a point E <br /> ;;; on the curve being given                                    <br /> ;;; Note: Page 137, Problem 85                                  <br /> ;;; 功能: 已知椭圆四切线及和椭圆上一点，求此椭圆。              <br /> ;;; 输入: 四切线AB,BC,CD,DA和椭圆上的一点E。                    <br /> ;;; 输出: 椭圆的解集。                                          <br /> ;;;=============================================================<br /> (defun ELL:P4T (A B C D E / ps B1 C1 P Q X s A0 AN AX D1 D2 F G H I SS)<br />   (setq Ps (ALG:Graham (list A B C D)))<br />   (if (and (= (length ps) 4) (ALG:Inside-p E ps))<br />     (progn<br />       (setq A  (car ps) B (cadr ps) C (caddr ps) D (cadddr ps))<br />       (setq I  (inters A C B D))<br />       (setq an (angle I E))<br />       (setq A0 (GEO:Angle1 I an A))<br />       (while (setq ps (cdr ps))<br />         (setq ax (geo:angle1 I an (car ps)))<br />         (if (> ax A0)<br />           (setq a0 ax X A A B B C C D D X)<br />         )<br />       )<br />       (setq B1 (inters B E A D nil))<br />       (setq C1 (inters C E A D nil))<br />       (setq D1 (distance A D))<br />       (setq D2 (distance C D))<br />       <br />       (setq SS (GEO:Cen_Foci A C1 D B1))<br />       (setq P  (caddr ss))<br />       (setq F  (inters P E C D nil))<br />       (if (setq X (ELL:5T A B C F P))<br />         (setq s (cons X s))<br />       )<br />       (setq Q (cadr ss))<br />       (setq G (inters Q E C D nil))<br />       (setq H (inters Q E B C nil))<br />       (if (setq x (Ell:5T A B H G D))<br />         (setq s (cons X s))<br />       )<br />     )<br />   )<br /> )

题25：已知椭圆一切线及和椭圆上四点，求此椭圆。

1. ;;;=============================================================
   
2. ;;; To describe an ellipse, four points on the curve A, B, C, D,
   
3. ;;; and a tangent PQ being given                                
   
4. ;;; Note: Page 139, Problem 87                                 
   
5. ;;; 功能: 已知椭圆一切线及和椭圆上四点，求此椭圆。              
   
6. ;;; 输入: 椭圆上的四点A,B,C,D和其切线PQ。                       
   
7. ;;; 输出: 椭圆的解集。                                          
   
8. ;;;=============================================================
   
9. (defun ELL:T4P (A B C D P Q / E F G H X S l)
   
10.   (setq l (ALG:Graham (list A B C D)))
    
11.   (setq A (car l) B (cadr l) C (caddr L) D (cadddr L))
    
12.   (setq E (inters A B P Q nil))
    
13.   (setq F (inters B C P Q nil))
    
14.   (setq G (inters C D P Q nil))
    
15.   (setq H (inters D A P Q nil))
    
16.            
    
17.   (foreach n (cdr (GEO:Cen_Foci E G F H))
    
18.     (Ent:make_point n)
    
19.     (if (setq x (ELL:5P A B C D N))
    
20.       (setq S (cons x S))
    
21.     )
    
22.   )
    
23.   (reverse S)
    
24. )

;;;=============================================================<br /> ;;; To describe an ellipse, four points on the curve A, B, C, D,<br /> ;;; and a tangent PQ being given                                <br /> ;;; Note: Page 139, Problem 87                                  <br /> ;;; 功能: 已知椭圆一切线及和椭圆上四点，求此椭圆。              <br /> ;;; 输入: 椭圆上的四点A,B,C,D和其切线PQ。                       <br /> ;;; 输出: 椭圆的解集。                                          <br /> ;;;=============================================================<br /> (defun ELL:T4P (A B C D P Q / E F G H X S l)<br />   (setq l (ALG:Graham (list A B C D)))<br />   (setq A (car l) B (cadr l) C (caddr L) D (cadddr L))<br />   (setq E (inters A B P Q nil))<br />   (setq F (inters B C P Q nil))<br />   (setq G (inters C D P Q nil))<br />   (setq H (inters D A P Q nil))<br />            <br />   (foreach n (cdr (GEO:Cen_Foci E G F H))<br />     (Ent:make_point n)<br />     (if (setq x (ELL:5P A B C D N))<br />       (setq S (cons x S))<br />     )<br />   )<br />   (reverse S)<br /> )

题26：过五点画一个椭圆。

此题可用解方程法，也可用作图法。下面是作图法代码：

1. ;;;=============================================================
   
2. ;;; To describe an ellipse, five points on the curve being given
   
3. ;;; Note: Page 138, Problem 86                                 
   
4. ;;; 功能: 过五点画一个椭圆（几何法）                           
   
5. ;;; 输入: 椭圆上的五点P1,P2,P3,P4,P5.                           
   
6. ;;; 输出: 椭圆的解。                                            
   
7. ;;;=============================================================
   
8. (defun ELL:5P_1 (p1 p2 p3 p4 p5 / p12 p23 p34 p45 t2 t3 t4 t23 t34 t42 m23 m34 m42 cen lst)
   
9.   (setq lst (ALG:Graham (list p1 p2 p3 p4 p5)))
   
10.   (if (= (length lst) 5)
    
11.     (progn
    
12.       (setq p1 (car lst))
    
13.       (setq p4 (cadr lst))
    
14.       (setq p2 (caddr lst))
    
15.       (setq p5 (cadddr lst))
    
16.       (setq p3 (last lst))
    
17. 
    
18.       (setq p12 (inters p5 p1 p2 p3 nil))
    
19.       (setq p23 (inters p1 p2 p3 p4 nil))
    
20.       (setq p34 (inters p2 p3 p4 p5 nil))
    
21.       (setq p45 (inters p3 p4 p5 p1 nil))
    
22. 
    
23.       (setq t2 (inters p12 p23 p4 p5 nil))
    
24.       (setq t3 (inters p23 p34 p5 p1 nil))
    
25.       (setq t4 (inters p34 p45 p1 p2 nil))
    
26.       
    
27.       (if (setq t23 (inters t2 p2 t3 p3 nil))
    
28.         (if (setq t34 (inters t3 p3 t4 p4 nil))
    
29.           (setq m23 (GEO:Midpoint p2 p3)
    
30.                 m34 (GEO:Midpoint p3 p4)
    
31.                 cen (inters t23 m23 t34 m34 nil)
    
32.           )
    
33.           (setq t42 (inters t4 p4 t2 p2 nil)
    
34.                 m42 (GEO:Midpoint p4 p2)
    
35.                 m23 (GEO:Midpoint p2 p3)
    
36.                 cen (inters t23 m23 t42 m42 nil)
    
37.           )
    
38.         )
    
39.         (setq t42 (inters t4 p4 t2 p2 nil)
    
40.               t34 (inters t3 p3 t4 p4 nil)
    
41.               m34 (GEO:Midpoint p3 p4)
    
42.               m42 (GEO:Midpoint p4 p2)
    
43.               cen (inters t42 m42 t34 m34 nil)
    
44.         )
    
45.       )
    
46.       (ELL:C3P cen p2 p3 p4)
    
47.     )
    
48.   )
    
49. )

;;;=============================================================<br /> ;;; To describe an ellipse, five points on the curve being given<br /> ;;; Note: Page 138, Problem 86                                  <br /> ;;; 功能: 过五点画一个椭圆（几何法）                            <br /> ;;; 输入: 椭圆上的五点P1,P2,P3,P4,P5.                           <br /> ;;; 输出: 椭圆的解。                                            <br /> ;;;=============================================================<br /> (defun ELL:5P_1 (p1 p2 p3 p4 p5 / p12 p23 p34 p45 t2 t3 t4 t23 t34 t42 m23 m34 m42 cen lst)<br />   (setq lst (ALG:Graham (list p1 p2 p3 p4 p5)))<br />   (if (= (length lst) 5)<br />     (progn<br />       (setq p1 (car lst))<br />       (setq p4 (cadr lst))<br />       (setq p2 (caddr lst))<br />       (setq p5 (cadddr lst))<br />       (setq p3 (last lst))<br /> <br />       (setq p12 (inters p5 p1 p2 p3 nil))<br />       (setq p23 (inters p1 p2 p3 p4 nil))<br />       (setq p34 (inters p2 p3 p4 p5 nil))<br />       (setq p45 (inters p3 p4 p5 p1 nil))<br /> <br />       (setq t2 (inters p12 p23 p4 p5 nil))<br />       (setq t3 (inters p23 p34 p5 p1 nil))<br />       (setq t4 (inters p34 p45 p1 p2 nil))<br />       <br />       (if (setq t23 (inters t2 p2 t3 p3 nil))<br />         (if (setq t34 (inters t3 p3 t4 p4 nil))<br />           (setq m23 (GEO:Midpoint p2 p3)<br />                 m34 (GEO:Midpoint p3 p4)<br />                 cen (inters t23 m23 t34 m34 nil)<br />           )<br />           (setq t42 (inters t4 p4 t2 p2 nil)<br />                 m42 (GEO:Midpoint p4 p2)<br />                 m23 (GEO:Midpoint p2 p3)<br />                 cen (inters t23 m23 t42 m42 nil)<br />           )<br />         )<br />         (setq t42 (inters t4 p4 t2 p2 nil)<br />               t34 (inters t3 p3 t4 p4 nil)<br />               m34 (GEO:Midpoint p3 p4)<br />               m42 (GEO:Midpoint p4 p2)<br />               cen (inters t42 m42 t34 m34 nil)<br />         )<br />       )<br />       (ELL:C3P cen p2 p3 p4)<br />     )<br />   )<br /> )

newer

又出大作，不过每种能配上图就更好了。

Highflybird

newer 发表于 2016-7-5 16:20
又出大作，不过每种能配上图就更好了。

正在编辑中，请等下回复。

ynhh

大师又出新作了啊
不知有没有  斜剖圆锥的截面  形状的程序
这可不是椭圆也不知如何表达啊

csharp

每次拜读大师的帖子都受益良多！

sicky111

喝口茶慢慢看。

yoyoho

;;;============================================================= ;;; To describe an ellipse, five points on the curve being given ;;; Note: Page 138, Problem 86                                   ;;; 功能: 过五点画一个椭圆（几何法）                             ;;; 输入: 椭圆上的五点P1,P2,P3,P4,P5.                            ;;; 输出: 椭圆的解。                                             ;;;============================================================= (defun ELL:5P_1 (p1 p2 p3 p4 p5 / p12 p23 p34 p45 t2 t3 t4 t23 t34 t42 m23 m34 m42 cen lst)   (setq lst (ALG:Graham (list p1 p2 p3 p4 p5)))   (if (= (length lst) 5)     (progn       (setq p1 (car lst))       (setq p4 (cadr lst))       (setq p2 (caddr lst))       (setq p5 (cadddr lst))       (setq p3 (last lst))        (setq p12 (inters p5 p1 p2 p3 nil))       (setq p23 (inters p1 p2 p3 p4 nil))       (setq p34 (inters p2 p3 p4 p5 nil))       (setq p45 (inters p3 p4 p5 p1 nil))        (setq t2 (inters p12 p23 p4 p5 nil))       (setq t3 (inters p23 p34 p5 p1 nil))       (setq t4 (inters p34 p45 p1 p2 nil))              (if (setq t23 (inters t2 p2 t3 p3 nil))         (if (setq t34 (inters t3 p3 t4 p4 nil))           (setq m23 (GEO:Midpoint p2 p3)                 m34 (GEO:Midpoint p3 p4)                 cen (inters t23 m23 t34 m34 nil)           )           (setq t42 (inters t4 p4 t2 p2 nil)                 m42 (GEO:Midpoint p4 p2)                 m23 (GEO:Midpoint p2 p3)                 cen (inters t23 m23 t42 m42 nil)           )         )         (setq t42 (inters t4 p4 t2 p2 nil)               t34 (inters t3 p3 t4 p4 nil)               m34 (GEO:Midpoint p3 p4)               m42 (GEO:Midpoint p4 p2)               cen (inters t42 m42 t34 m34 nil)         )       )       (ELL:C3P cen p2 p3 p4)     )   ) )

yoyoho

感谢 Highflybird 分享程序,3Q!

SYTDD

感谢 Highflybird 分享！厉害