【越飞越高讲堂14】椭圆论

highflybir

收集了一些与椭圆相关的程序和链接：

一 椭圆的几个基本参数：
DXF 组码中的几个数值
10  中心点
11  长轴矢量
40  长短比率
41  起点角度
42  终点角度
210 法线矢量

这些参数可以由entget得到，也可以由activeX方法得到。
注意 起点角度和终点角度的计算，如果是不是椭圆弧，是全椭圆，则这个数值为：0和2*Pi
如果是椭圆弧，则如图；

vlax-curve-getParamAtPoint 其中的参数指的就是这点的角度值（用弧度表示）。
椭圆的离心率由椭圆的长短比率得出。

1. (sqrt  (- 1 (* ratio ratio)))

(sqrt  (- 1 (* ratio ratio)))

离心率越大圆就越扁，越小则越接近于圆.

二 椭圆上某点的切线：
可以由vlax-curve-getFirstDeriv 算出  也可以由某个点的参数通过数学方法算出。

三 空间椭圆的变换矩阵
由椭圆的长轴矢量，和短轴矢量以及法线矢量可以构成椭圆的自身的变换坐标系。

1. ;;;下面程序用以获得椭圆的变换矩阵。
   
2. (defun Mat:GetEllipseTransMatrix (e / dxf Nrm Cen Maj Mnr ptb DX DY DZ mat)        
   
3.   (defun AppendToMatrix (mat org)
   
4.     (append
   
5.       (mapcar 'append mat (mapcar 'list org))
   
6.       '((0. 0. 0. 1.))
   
7.     )
   
8.   )
   
9. 
   
10.   (setq dxf (entget e))
    
11.   (setq Nrm (cdr (assoc 210 dxf)))
    
12.   (setq Cen (cdr (assoc 10 dxf)))
    
13.   (setq Maj (cdr (assoc 11 dxf)))
    
14.   (setq PtB (vlax-curve-getPointAtParam e (/ pi 2)))
    
15.   (setq Mnr (mapcar '- ptb cen))
    
16.   (setq DX  (Mat:unit Maj))
    
17.   (setq DY  (Mat:unit Mnr))
    
18.   (setq DZ  (Mat:unit Nrm))
    
19.   (setq mat (list DX DY DZ))
    
20.   (list
    
21.     (AppendToMatrix mat (mapcar '- (Mat:mxv mat cen)))        ;WCS->OCS 由世界坐标系变换到物体坐标系
    
22.     (AppendToMatrix (Mat:trp mat) cen)                        ;OCS->WCS 由物体坐标系变换到世界坐标系
    
23.   )
    
24. )
    
25. ;;;以下为测试程序
    
26. (defun c:test1 (/ sel ent mat obj doc)
    
27.   (if (setq sel (ssget ":S" '((0 . "ELLIPSE"))))
    
28.     (progn
    
29.       (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
    
30.       (vla-StartUndoMark doc)
    
31.       (setq ent (ssname sel 0))
    
32.       (setq mat (Mat:GetEllipseTransMatrix ent))
    
33.       (setq obj (vlax-ename->vla-object ent))
    
34.       (vla-transformby obj (vlax-tmatrix (car mat)))
    
35.       (command "Select" ent pause)
    
36.       (vla-transformby obj (vlax-tmatrix (cadr mat)))
    
37.       (vla-EndUndoMark doc)
    
38.       (princ)
    
39.     )
    
40.   )
    
41. )
    

;;;下面程序用以获得椭圆的变换矩阵。<br /> (defun Mat:GetEllipseTransMatrix (e / dxf Nrm Cen Maj Mnr ptb DX DY DZ mat)        <br />   (defun AppendToMatrix (mat org)<br />     (append<br />       (mapcar 'append mat (mapcar 'list org))<br />       '((0. 0. 0. 1.))<br />     )<br />   )<br /> <br />   (setq dxf (entget e))<br />   (setq Nrm (cdr (assoc 210 dxf)))<br />   (setq Cen (cdr (assoc 10 dxf)))<br />   (setq Maj (cdr (assoc 11 dxf)))<br />   (setq PtB (vlax-curve-getPointAtParam e (/ pi 2)))<br />   (setq Mnr (mapcar '- ptb cen))<br />   (setq DX  (Mat:unit Maj))<br />   (setq DY  (Mat:unit Mnr))<br />   (setq DZ  (Mat:unit Nrm))<br />   (setq mat (list DX DY DZ))<br />   (list<br />     (AppendToMatrix mat (mapcar '- (Mat:mxv mat cen)))        ;WCS->OCS 由世界坐标系变换到物体坐标系<br />     (AppendToMatrix (Mat:trp mat) cen)                        ;OCS->WCS 由物体坐标系变换到世界坐标系<br />   )<br /> )<br /> ;;;以下为测试程序<br /> (defun c:test1 (/ sel ent mat obj doc)<br />   (if (setq sel (ssget ":S" '((0 . "ELLIPSE"))))<br />     (progn<br />       (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))<br />       (vla-StartUndoMark doc)<br />       (setq ent (ssname sel 0))<br />       (setq mat (Mat:GetEllipseTransMatrix ent))<br />       (setq obj (vlax-ename->vla-object ent))<br />       (vla-transformby obj (vlax-tmatrix (car mat)))<br />       (command "Select" ent pause)<br />       (vla-transformby obj (vlax-tmatrix (cadr mat)))<br />       (vla-EndUndoMark doc)<br />       (princ)<br />     )<br />   )<br /> )<br />

1. ;;;相关矩阵函数;;;----------------------------------------------------;
   
2. ;;; 向量的模(长度)                                       ;
   
3. ;;; Vector Norm - Lee Mac                               ;
   
4. ;;; Args: v - vector in R^n                               ;
   
5. ;;;----------------------------------------------------;
   
6. (defun MAT:norm ( v )
   
7.   (sqrt (apply '+ (mapcar '* v v)))
   
8. )
   
9. 
   
10. ;;;----------------------------------------------------;
    
11. ;;; 向量乘标量(系数)                                       ;
    
12. ;;; Vector x Scalar - Lee Mac                               ;
    
13. ;;; Args: v - vector in R^n, s - real scalar               ;
    
14. ;;;----------------------------------------------------;
    
15. (defun MAT:vxs ( v s )
    
16.   (mapcar '(lambda ( n ) (* n s)) v)
    
17. )
    
18. 
    
19. ;;;----------------------------------------------------;
    
20. ;;; 单位向量                                               ;
    
21. ;;; Unit Vector - Lee Mac                              ;
    
22. ;;; Args: v - vector in R^n                               ;
    
23. ;;;----------------------------------------------------;
    
24. (defun MAT:unit ( v )
    
25.   ( (lambda ( n )
    
26.       (if (equal 0.0 n 1e-14)
    
27.         nil
    
28.         (MAT:vxs v (/ 1.0 n))
    
29.       )
    
30.     )
    
31.     (MAT:norm v)
    
32.   )
    
33. )
    
34. 
    
35. ;;;----------------------------------------------------;
    
36. ;;; 向量的点积                                         ;
    
37. ;;; MAT:vxv Returns the dot product of 2 vectors       ;
    
38. ;;;----------------------------------------------------;
    
39. (defun MAT:vxv (v1 v2)
    
40.   (apply '+ (mapcar '* v1 v2))
    
41. )
    
42. 
    
43. ;;;----------------------------------------------------;
    
44. ;;; 两向量的叉积                                       ;
    
45. ;;; Vector Cross Product - Lee Mac                       ;
    
46. ;;; Args: u,v - vectors in R^3                               ;
    
47. ;;;----------------------------------------------------;
    
48. (defun MAT:v^v ( u v )
    
49.   (list
    
50.     (- (* (cadr u) (caddr v)) (* (cadr v) (caddr u)))
    
51.     (- (* (car  v) (caddr u)) (* (car  u) (caddr v)))
    
52.     (- (* (car  u) (cadr  v)) (* (car  v) (cadr  u)))
    
53.   )
    
54. )
    
55. 
    
56. ;;;----------------------------------------------------;
    
57. ;;; 矩阵转置                                           ;
    
58. ;;; MAT:trp Transpose a matrix -Doug Wilson-           ;
    
59. ;;;----------------------------------------------------;
    
60. (defun MAT:trp (m)
    
61.   (apply 'mapcar (cons 'list m))
    
62. )
    
63. 
    
64. ;;;----------------------------------------------------;
    
65. ;;; 向量的矩阵变换(向量乘矩阵)                         ;
    
66. ;;; Matrix x Vector - Vladimir Nesterovsky             ;
    
67. ;;; Args: m - nxn matrix, v - vector in R^n            ;
    
68. ;;;----------------------------------------------------;
    
69. (defun MAT:mxv (m v)
    
70.   (mapcar (function (lambda (r) (apply '+ (mapcar '* r v)))) m)
    
71. )
    
72. 
    
73. ;;;----------------------------------------------------;
    
74. ;;; 点到矩阵的变换                                     ;
    
75. ;;;----------------------------------------------------;
    
76. (defun MAT:mxp (m p)
    
77.   (reverse (cdr (reverse (MAT:mxv m (append p '(1.0))))))
    
78. )
    
79. 
    
80. ;;;----------------------------------------------------;
    
81. ;;; 矩阵相乘                                           ;
    
82. ;;; MAT:mxm Multiply two matrices -Vladimir Nesterovsky;
    
83. ;;;----------------------------------------------------;
    
84. (defun MAT:mxm (m q)
    
85.   (mapcar (function (lambda (r) (MAT:mxv (MAT:trp q) r))) m)
    
86. )

;;;相关矩阵函数;;;----------------------------------------------------;<br /> ;;; 向量的模(长度)                                       ;<br /> ;;; Vector Norm - Lee Mac                               ;<br /> ;;; Args: v - vector in R^n                               ;<br /> ;;;----------------------------------------------------;<br /> (defun MAT:norm ( v )<br />   (sqrt (apply '+ (mapcar '* v v)))<br /> )<br /> <br /> ;;;----------------------------------------------------;<br /> ;;; 向量乘标量(系数)                                       ;<br /> ;;; Vector x Scalar - Lee Mac                               ;<br /> ;;; Args: v - vector in R^n, s - real scalar               ;<br /> ;;;----------------------------------------------------;<br /> (defun MAT:vxs ( v s )<br />   (mapcar '(lambda ( n ) (* n s)) v)<br /> )<br /> <br /> ;;;----------------------------------------------------;<br /> ;;; 单位向量                                               ;<br /> ;;; Unit Vector - Lee Mac                              ;<br /> ;;; Args: v - vector in R^n                               ;<br /> ;;;----------------------------------------------------;<br /> (defun MAT:unit ( v )<br />   ( (lambda ( n )<br />       (if (equal 0.0 n 1e-14)<br />         nil<br />         (MAT:vxs v (/ 1.0 n))<br />       )<br />     )<br />     (MAT:norm v)<br />   )<br /> )<br /> <br /> ;;;----------------------------------------------------;<br /> ;;; 向量的点积                                         ;<br /> ;;; MAT:vxv Returns the dot product of 2 vectors       ;<br /> ;;;----------------------------------------------------;<br /> (defun MAT:vxv (v1 v2)<br />   (apply '+ (mapcar '* v1 v2))<br /> )<br /> <br /> ;;;----------------------------------------------------;<br /> ;;; 两向量的叉积                                       ;<br /> ;;; Vector Cross Product - Lee Mac                       ;<br /> ;;; Args: u,v - vectors in R^3                               ;<br /> ;;;----------------------------------------------------;<br /> (defun MAT:v^v ( u v )<br />   (list<br />     (- (* (cadr u) (caddr v)) (* (cadr v) (caddr u)))<br />     (- (* (car  v) (caddr u)) (* (car  u) (caddr v)))<br />     (- (* (car  u) (cadr  v)) (* (car  v) (cadr  u)))<br />   )<br /> )<br /> <br /> ;;;----------------------------------------------------;<br /> ;;; 矩阵转置                                           ;<br /> ;;; MAT:trp Transpose a matrix -Doug Wilson-           ;<br /> ;;;----------------------------------------------------;<br /> (defun MAT:trp (m)<br />   (apply 'mapcar (cons 'list m))<br /> )<br /> <br /> ;;;----------------------------------------------------;<br /> ;;; 向量的矩阵变换(向量乘矩阵)                         ;<br /> ;;; Matrix x Vector - Vladimir Nesterovsky             ;<br /> ;;; Args: m - nxn matrix, v - vector in R^n            ;<br /> ;;;----------------------------------------------------;<br /> (defun MAT:mxv (m v)<br />   (mapcar (function (lambda (r) (apply '+ (mapcar '* r v)))) m)<br /> )<br /> <br /> ;;;----------------------------------------------------;<br /> ;;; 点到矩阵的变换                                     ;<br /> ;;;----------------------------------------------------;<br /> (defun MAT:mxp (m p)<br />   (reverse (cdr (reverse (MAT:mxv m (append p '(1.0))))))<br /> )<br /> <br /> ;;;----------------------------------------------------;<br /> ;;; 矩阵相乘                                           ;<br /> ;;; MAT:mxm Multiply two matrices -Vladimir Nesterovsky;<br /> ;;;----------------------------------------------------;<br /> (defun MAT:mxm (m q)<br />   (mapcar (function (lambda (r) (MAT:mxv (MAT:trp q) r))) m)<br /> )

如果椭圆位于图块内或者嵌套块内，关于其变换矩阵可以参考这个帖子的讨论：http://bbs.mjtd.com/thread-93828-1-1.html|;
这个地方的讨论已经很深入了。

四 椭圆的几种创建：
0. 由基本要素的创建。

1. ;;;=====================================================
   
2. ;;;功能: 画一个椭圆或者椭圆弧                             
   
3. ;;;参数: 中心，长轴，短轴和旋转角度，起始角度，终点角度
   
4. ;;;返回: 一个椭圆实体                                   
   
5. ;;;=====================================================
   
6. (defun Make-Ellipse (cen a b ang an1 an2 / m n an)
   
7.   (if (> b a)
   
8.     (setq m b n a an (+ ang (/ pi 2)))
   
9.     (setq m a n b an ang)
   
10.   )
    
11.   (entmakeX
    
12.     (list
    
13.       '(0 . "ELLIPSE")
    
14.       '(100 . "AcDbEntity")
    
15.       '(100 . "AcDbEllipse")
    
16.       (cons 10 cen)
    
17.       (cons 11 (polar '(0. 0. 0.) an m))
    
18.       (cons 40 (/ n m 1.0))
    
19.       (cons 41 an1)
    
20.       (cons 42 an2)
    
21.     )
    
22.   )
    
23. )

;;;=====================================================<br /> ;;;功能: 画一个椭圆或者椭圆弧                             <br /> ;;;参数: 中心，长轴，短轴和旋转角度，起始角度，终点角度 <br /> ;;;返回: 一个椭圆实体                                   <br /> ;;;=====================================================<br /> (defun Make-Ellipse (cen a b ang an1 an2 / m n an)<br />   (if (> b a)<br />     (setq m b n a an (+ ang (/ pi 2)))<br />     (setq m a n b an ang)<br />   )<br />   (entmakeX<br />     (list<br />       '(0 . "ELLIPSE")<br />       '(100 . "AcDbEntity")<br />       '(100 . "AcDbEllipse")<br />       (cons 10 cen)<br />       (cons 11 (polar '(0. 0. 0.) an m))<br />       (cons 40 (/ n m 1.0))<br />       (cons 41 an1)<br />       (cons 42 an2)<br />     )<br />   )<br /> )

1. 四点画水平椭圆。
参见：http://bbs.mjtd.com/thread-91856-1-1.html
2. 已知椭圆的圆心和椭圆上的三点创建一个椭圆。
参见:http://bbs.mjtd.com/thread-91856-1-1.html

3. 已知椭圆的四条切线创建一个水平椭圆。
参见:http://bbs.mjtd.com/forum.php?mod=viewthread&tid=55068

4. 过五点画椭圆，有几何解法，
参见:http://bbs.mjtd.com/forum.php?mo ... 45&page=1#pid410208

1. (defun ELL:5PEllipse (p1 p2 p3 p4 p5 / p12 p23 p34 p45 t2 t3 t4 t23 t34 t45 cen)
   
2.   (setq p12 (inters p5 p1 p2 p3 nil))
   
3.   (setq p23 (inters p1 p2 p3 p4 nil))
   
4.   (setq p34 (inters p2 p3 p4 p5 nil))
   
5.   (setq p45 (inters p3 p4 p5 p1 nil))
   
6.   (setq t2  (inters p12 p23 p4 p5 nil))
   
7.   (setq t3  (inters p23 p34 p5 p1 nil))
   
8.   (setq t4  (inters p34 p45 p1 p2 nil))
   
9.   (setq t23 (inters t2 p2 t3 p3 nil))
   
10.   (setq t34 (inters t3 p3 t4 p4 nil))
    
11.   (setq m23 (midpt p2 p3))
    
12.   (setq m34 (midpt p3 p4))
    
13.   (setq cen (inters t23 m23 t34 m34 nil))
    
14.   (Mat:C3P-Ellipse cen p2 p3 p4)
    
15. )
    
16. (defun midpt (p1 p2)
    
17.   (mapcar (function (lambda (x) (* x 0.5))) (mapcar '+ p1 p2))
    
18. )
    
19. (defun c:test5 (/ p1 p2 p3 p4 p5 ret)
    
20.   (initget 1)
    
21.   (setq p1 (getpoint "\n输入第一点:"))
    
22.   (initget 1)
    
23.   (setq p2 (getpoint "\n输入第二点:"))
    
24.   (initget 1)
    
25.   (setq p3 (getpoint "\n输入第三点:"))
    
26.   (initget 1)
    
27.   (setq p4 (getpoint "\n输入第四点:"))
    
28.   (initget 1)
    
29.   (setq p5 (getpoint "\n输入第五点:"))
    
30.   (setq ret (ELL:5PEllipse p1 p2 p3 p4 p5))
    
31.   (apply 'Ell:Make-Ellipse ret)
    
32.   (princ)
    
33. )  
    
34. 
    

(defun ELL:5PEllipse (p1 p2 p3 p4 p5 / p12 p23 p34 p45 t2 t3 t4 t23 t34 t45 cen)<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 />   (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 />   (setq t23 (inters t2 p2 t3 p3 nil))<br />   (setq t34 (inters t3 p3 t4 p4 nil))<br />   (setq m23 (midpt p2 p3))<br />   (setq m34 (midpt p3 p4))<br />   (setq cen (inters t23 m23 t34 m34 nil))<br />   (Mat:C3P-Ellipse cen p2 p3 p4)<br /> )<br /> (defun midpt (p1 p2)<br />   (mapcar (function (lambda (x) (* x 0.5))) (mapcar '+ p1 p2))<br /> )<br /> (defun c:test5 (/ p1 p2 p3 p4 p5 ret)<br />   (initget 1)<br />   (setq p1 (getpoint "\n输入第一点:"))<br />   (initget 1)<br />   (setq p2 (getpoint "\n输入第二点:"))<br />   (initget 1)<br />   (setq p3 (getpoint "\n输入第三点:"))<br />   (initget 1)<br />   (setq p4 (getpoint "\n输入第四点:"))<br />   (initget 1)<br />   (setq p5 (getpoint "\n输入第五点:"))<br />   (setq ret (ELL:5PEllipse p1 p2 p3 p4 p5))<br />   (apply 'Ell:Make-Ellipse ret)<br />   (princ)<br /> )  <br /> <br />

五 椭圆的曲率问题

如果要在CAD中几何作图，可以参考此贴：
http://bbs.mjtd.com/thread-62980-1-1.html
下面程序为获取椭圆的曲率和转弯半径。

1. ;;;=====================================================
   
2. ;;;功能: 获取椭圆上一点处的曲率和转弯半径               
   
3. ;;;参数: 椭圆实体和椭圆上的一点                        
   
4. ;;;返回: 此处离心圆圆心、转弯半径及其曲率（离心率）     
   
5. ;;;=====================================================
   
6. (defun ELL:GetCurvature (en pt / dxf maj rat a b p par x y k v1 v2 rad cen)
   
7.   (setq dxf (entget en))
   
8.   (setq maj (cdr (assoc 11 dxf)))
   
9.   (setq rat (cdr (assoc 40 dxf)))
   
10.   (setq a   (distance '(0 0) maj))
    
11.   (setq b   (* a rat))
    
12.   (setq p   (vlax-curve-getclosestpointto en pt))
    
13.   (setq par (vlax-curve-getParamAtPoint en p))
    
14.   (setq v1  (vlax-curve-getFirstDeriv en par))
    
15.   (setq v2  (list (- (cadr v1)) (car v1) (caddr v1)))
    
16.   (setq x   (* a (cos par)))
    
17.   (setq y   (* b (sin par)))
    
18.   (setq k   (expt rat 4))
    
19.   (setq rad (/ (expt (+ (* y y) (* k x x)) 1.5) rat rat b b))
    
20.   (setq cen (polar p (angle '(0 0 0) v2) rad))
    
21.   (list cen rad (/ 1 rad))
    
22. )
    
23. 
    
24. ;;;测试程序:
    
25. (defun c:test2 (/ sel ent dxf pnt ret)
    
26.   (setq sel (nentselp "\n选取椭圆："))
    
27.   (if (and (setq ent (car sel))
    
28.            (setq dxf (entget ent))
    
29.            (= "ELLIPSE" (cdr (assoc 0 dxf)))
    
30.       )
    
31.     (progn
    
32.       (setq pnt (cadr sel))
    
33.       (setq ret (ELL:GetCurvature ent (trans pnt 1 0)))
    
34.       (princ ret)
    
35.       (entmakeX
    
36.         (list
    
37.           '(0 . "CIRCLE")
    
38.           (cons 10 (car ret))
    
39.           (cons 40 (cadr ret))
    
40.         )
    
41.       )
    
42.     )
    
43.   )
    
44.   (princ)
    
45. )

;;;=====================================================<br /> ;;;功能: 获取椭圆上一点处的曲率和转弯半径               <br /> ;;;参数: 椭圆实体和椭圆上的一点                         <br /> ;;;返回: 此处离心圆圆心、转弯半径及其曲率（离心率）     <br /> ;;;=====================================================<br /> (defun ELL:GetCurvature (en pt / dxf maj rat a b p par x y k v1 v2 rad cen)<br />   (setq dxf (entget en))<br />   (setq maj (cdr (assoc 11 dxf)))<br />   (setq rat (cdr (assoc 40 dxf)))<br />   (setq a   (distance '(0 0) maj))<br />   (setq b   (* a rat))<br />   (setq p   (vlax-curve-getclosestpointto en pt))<br />   (setq par (vlax-curve-getParamAtPoint en p))<br />   (setq v1  (vlax-curve-getFirstDeriv en par))<br />   (setq v2  (list (- (cadr v1)) (car v1) (caddr v1)))<br />   (setq x   (* a (cos par)))<br />   (setq y   (* b (sin par)))<br />   (setq k   (expt rat 4)) <br />   (setq rad (/ (expt (+ (* y y) (* k x x)) 1.5) rat rat b b))<br />   (setq cen (polar p (angle '(0 0 0) v2) rad))<br />   (list cen rad (/ 1 rad))<br /> )<br /> <br /> ;;;测试程序:<br /> (defun c:test2 (/ sel ent dxf pnt ret)<br />   (setq sel (nentselp "\n选取椭圆："))<br />   (if (and (setq ent (car sel))<br />            (setq dxf (entget ent))<br />            (= "ELLIPSE" (cdr (assoc 0 dxf)))<br />       )<br />     (progn<br />       (setq pnt (cadr sel))<br />       (setq ret (ELL:GetCurvature ent (trans pnt 1 0)))<br />       (princ ret)<br />       (entmakeX<br />         (list<br />           '(0 . "CIRCLE")<br />           (cons 10 (car ret))<br />           (cons 40 (cadr ret))<br />         )<br />       )<br />     )<br />   )<br />   (princ)<br /> )

六 Steiner椭圆问题。

参见:
http://bbs.mjtd.com/thread-96417-1-1.html
下面为程序：


七 椭圆的包围盒和最小包围盒

1. (defun c:test3 (/ i sel ent lst obj pta ptb p1 p2 p3 p4 t0)
   
2.   (setq i 0)
   
3.   (if (setq sel (ssget '((0 . "ELLIPSE"))))
   
4.     (progn                 
   
5.       (repeat (sslength sel)
   
6.         (setq ent (ssname sel i))
   
7.         (setq obj (vlax-ename->vla-object ent))
   
8.         (setq lst (vla-getboundingbox obj 'pta 'ptb))
   
9.         (setq pta (vlax-safearray->list pta))
   
10.         (setq ptb (vlax-safearray->list ptb))
    
11.         (setq p1 (list (car pta) (cadr pta)))
    
12.         (setq p2 (list (car ptb) (cadr pta)))
    
13.         (setq p3 (list (car ptb) (cadr ptb)))
    
14.         (setq p4 (list (car pta) (cadr ptb)))
    
15.         (entmake
    
16.           (list
    
17.             '(0 . "LWPOLYLINE")
    
18.             '(100 . "AcDbEntity")
    
19.             '(100 . "AcDbPolyline")
    
20.             '(90 . 4)
    
21.             '(70 . 1)
    
22.             (cons 10 p1)
    
23.             (cons 10 p2)
    
24.             (cons 10 p3)
    
25.             (cons 10 p4)
    
26.           )
    
27.         )
    
28.         (setq i (1+ i))
    
29.       )
    
30.     )
    
31.   )
    
32.   (princ)
    
33. )

(defun c:test3 (/ i sel ent lst obj pta ptb p1 p2 p3 p4 t0)<br />   (setq i 0)<br />   (if (setq sel (ssget '((0 . "ELLIPSE"))))<br />     (progn                 <br />       (repeat (sslength sel)<br />         (setq ent (ssname sel i))<br />         (setq obj (vlax-ename->vla-object ent))<br />         (setq lst (vla-getboundingbox obj 'pta 'ptb))<br />         (setq pta (vlax-safearray->list pta))<br />         (setq ptb (vlax-safearray->list ptb))<br />         (setq p1 (list (car pta) (cadr pta)))<br />         (setq p2 (list (car ptb) (cadr pta)))<br />         (setq p3 (list (car ptb) (cadr ptb)))<br />         (setq p4 (list (car pta) (cadr ptb)))<br />         (entmake<br />           (list<br />             '(0 . "LWPOLYLINE")<br />             '(100 . "AcDbEntity")<br />             '(100 . "AcDbPolyline")<br />             '(90 . 4)<br />             '(70 . 1)<br />             (cons 10 p1)<br />             (cons 10 p2)<br />             (cons 10 p3)<br />             (cons 10 p4)<br />           )<br />         )<br />         (setq i (1+ i))<br />       )<br />     )<br />   )<br />   (princ)<br /> )

最小包围盒：

1. ;;;获取椭圆的最小包围盒
   
2. (defun ELL:GetMinBox (ent / CEN DXF EN MAJ P1 P2 P3 P4 PTB PTD)
   
3.   (setq dxf (entget ent))
   
4.   (setq cen (cdr (assoc 10 dxf)))
   
5.   (setq maj (cdr (assoc 11 dxf)))
   
6.   (setq ptb (vlax-curve-getPointAtParam en (* pi 0.5)))
   
7.   (setq ptd (vlax-curve-getPointAtParam en (* pi 1.5)))
   
8.   (setq p1  (mapcar '- ptd maj))
   
9.   (setq p2  (mapcar '+ ptd maj))
   
10.   (setq p3  (mapcar '+ ptb maj))
    
11.   (setq p4  (mapcar '- ptb maj))
    
12.   (list p1 p2 p3 p4)
    
13. )
    
14. ;;;测试程序
    
15. (defun c:test4 (/ sel ent ret e)
    
16.   (if (setq sel (ssget ":S" '((0 . "ELLIPSE"))))
    
17.     (progn
    
18.       (setq ent (ssname sel 0))
    
19.       (setq ret (ELL:getMinBox ent))
    
20.       (setq e (Entmake (list '(0 . "POLYLINE")'(70 . 9))))
    
21.       (foreach p (reverse ret)
    
22.         (entmake (list '(0 . "VERTEX")'(70 . 32)(cons 10 p)))
    
23.       )
    
24.       (entmake '((0 . "SEQEND")))
    
25.     )
    
26.   )
    
27.   (princ)
    
28. )

;;;获取椭圆的最小包围盒<br /> (defun ELL:GetMinBox (ent / CEN DXF EN MAJ P1 P2 P3 P4 PTB PTD)<br />   (setq dxf (entget ent))<br />   (setq cen (cdr (assoc 10 dxf)))<br />   (setq maj (cdr (assoc 11 dxf)))<br />   (setq ptb (vlax-curve-getPointAtParam en (* pi 0.5)))<br />   (setq ptd (vlax-curve-getPointAtParam en (* pi 1.5)))<br />   (setq p1  (mapcar '- ptd maj))<br />   (setq p2  (mapcar '+ ptd maj))<br />   (setq p3  (mapcar '+ ptb maj))<br />   (setq p4  (mapcar '- ptb maj))<br />   (list p1 p2 p3 p4)<br /> )<br /> ;;;测试程序<br /> (defun c:test4 (/ sel ent ret e)<br />   (if (setq sel (ssget ":S" '((0 . "ELLIPSE"))))<br />     (progn<br />       (setq ent (ssname sel 0))<br />       (setq ret (ELL:getMinBox ent))<br />       (setq e (Entmake (list '(0 . "POLYLINE")'(70 . 9))))<br />       (foreach p (reverse ret)<br />         (entmake (list '(0 . "VERTEX")'(70 . 32)(cons 10 p)))<br />       )<br />       (entmake '((0 . "SEQEND")))<br />     )<br />   )<br />   (princ)<br /> )

八 椭圆拟合问题：
http://bbs.mjtd.com/thread-56692-1-1.html
下面的帖子是用圆弧拟合椭圆的讨论：
http://bbs.mjtd.com/thread-86496-3-1.html

九 椭圆的公切线问题
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=82900

十 椭圆的与直线的相交问题
http://bbs.mjtd.com/thread-62003-2-1.html

十一 最似圆椭圆问题
http://bbs.mjtd.com/thread-62903-1-1.html
以下是程序:

1. ;;;----------------------------------------------------;
   
2. ;;;过四点的最接近圆的椭圆                              ;
   
3. ;;;----------------------------------------------------;
   
4. (defun Ell:NearToCircleEllipse (Pa Pb Pc Pd / CCC InC Pd1 Pe Pe1)
   
5.   (setq CCC (Tri:CircumCenter Pa Pb Pc))
   
6.   (setq InC (Tri:InCenter Pa Pb Pc))
   
7.   (setq Pd1 (Tri:Isogonal-Conjugate-Point-1 Pd Pa Pb InC))
   
8.   (setq Pe  (polar Pd1 (+ (angle Pd1 CCC) (/ pi 2)) 1))
   
9.   (setq Pe1 (Tri:Isogonal-Conjugate-Point-1 Pe Pa Pb InC))
   
10.   (ELL:5PEllipse pa pb pc pd pe1)
    
11. )
    
12. ;;;----------------------------------------------------;
    
13. ;;;定比点                                              ;
    
14. ;;;----------------------------------------------------;
    
15. (defun Mat:Proportion (k p1 p2)
    
16.   (mapcar (function (lambda (u v) (+ u (* k (- v u))))) p1 p2)
    
17. )
    
18. ;;;----------------------------------------------------;
    
19. ;;;两矢量的点积                                        ;
    
20. ;;;----------------------------------------------------;
    
21. (defun Mat:Dot (v1 v2)
    
22.   (apply '+ (mapcar '* v1 v2))
    
23. )
    
24. ;;;----------------------------------------------------;
    
25. ;;;镜像点                                              ;
    
26. ;;;----------------------------------------------------;
    
27. (defun Mat:MirrorPoint (P P1 p2 / v1 v2 d1 p3 p4)
    
28.   (if (equal p1 p2 1e-8)
    
29.     (Mat:Proportion 2 p p1)
    
30.     (setq v1 (mapcar '- p p1)
    
31.    v2 (mapcar '- p2 p1)
    
32.    d1 (distance p1 p2)
    
33.    p3 (Mat:Proportion (/ (Mat:Dot v1 v2) d1 d1) p1 p2)
    
34.    p4 (Mat:Proportion 2 p p3)
    
35.     )   
    
36.   )
    
37. )
    
38. ;;;----------------------------------------------------;
    
39. ;;;三角形外心                                          ;
    
40. ;;;----------------------------------------------------;
    
41. (defun Tri:CircumCenter (Pa Pb Pc / Vb Vc Bx By Cx Cy BB CC D)
    
42.   (setq Vb (mapcar '- Pb Pa))
    
43.   (setq Vc (mapcar '- Pc Pa))
    
44.   (setq Bx (car  Vb))
    
45.   (setq By (cadr Vb))
    
46.   (setq Cx (car  Vc))
    
47.   (setq Cy (cadr Vc))
    
48.   (setq BB (+ (* Bx Bx) (* By By)))
    
49.   (setq CC (+ (* Cx Cx) (* Cy Cy)))
    
50.   (setq D  (- (* Bx Cy) (* By Cx)))
    
51.   (setq D  (+ D D))
    
52.   (if (/= D 0.0)
    
53.     (progn
    
54.       (setq dx (/ (- (* Cy BB) (* By CC)) D))
    
55.       (setq dy (/ (- (* Bx CC) (* Cx BB)) D))
    
56.       (mapcar '+ Pa (list dx dy))
    
57.     )
    
58.   )
    
59. )
    
60. ;;;----------------------------------------------------;
    
61. ;;;三角形内心                                          ;
    
62. ;;;----------------------------------------------------;
    
63. (defun Tri:InCenter (pa pb pc / a b c p q)
    
64.   (setq a (distance pb pc))
    
65.   (setq b (distance pc pa))
    
66.   (setq c (distance pa pb))
    
67.   (setq p (Mat:Proportion (/ b (+ b c)) pc pb))
    
68.   (setq q (Mat:Proportion (/ a (+ a c)) pc pa))
    
69.   (inters pa p pb q)
    
70. )
    
71. ;;;----------------------------------------------------;
    
72. ;;;等角共轭点                                          ;
    
73. ;;;----------------------------------------------------;
    
74. (defun Tri:Isogonal-Conjugate-Point (Pt Pa Pb Pc / Pt1 Pt2 Inc)
    
75.   (setq InC (Tri:InCenter Pa Pb Pc))
    
76.   (setq Pt1 (Mat:MirrorPoint Pt Pa Inc))
    
77.   (setq pt2 (Mat:MirrorPoint Pt Pb Inc))
    
78.   (inters Pa Pt1 Pb Pt2 nil)
    
79. )
    
80. ;;;----------------------------------------------------;
    
81. ;;;如果已知三角形内心，则可以简略计算                  ;
    
82. ;;;----------------------------------------------------;
    
83. (defun Tri:Isogonal-Conjugate-Point-1 (Pt Pa Pb Inc / Pt1 Pt2)
    
84.   (setq Pt1 (Mat:MirrorPoint Pt Pa Inc))
    
85.   (setq Pt2 (Mat:MirrorPoint Pt Pb Inc))
    
86.   (inters Pa Pt1 Pb Pt2 nil)
    
87. )
    
88. ;;;测试程序
    
89. (defun c:test7 (/ pa pb pc pd ret)
    
90.   (initget 1)
    
91.   (setq pa (getpoint "\n输入第一点:"))
    
92.   (initget 1)
    
93.   (setq pb (getpoint "\n输入第二点:"))
    
94.   (initget 1)
    
95.   (setq pc (getpoint "\n输入第三点:"))
    
96.   (initget 1)
    
97.   (setq pd (getpoint "\n输入映射点:"))
    
98.   
    
99.   (Ent:Make-Poly (list pa pb pc pd))
    
100.   (setq ret (Ell:NearToCircleEllipse Pd pa pb pc))
     
101.   (and ret (apply 'Ell:Make-Ellipse ret))
     
102. 
     
103.   (princ)
     
104. )
     

;;;----------------------------------------------------;<br /> ;;;过四点的最接近圆的椭圆                              ;<br /> ;;;----------------------------------------------------;<br /> (defun Ell:NearToCircleEllipse (Pa Pb Pc Pd / CCC InC Pd1 Pe Pe1)<br />   (setq CCC (Tri:CircumCenter Pa Pb Pc))<br />   (setq InC (Tri:InCenter Pa Pb Pc))<br />   (setq Pd1 (Tri:Isogonal-Conjugate-Point-1 Pd Pa Pb InC))<br />   (setq Pe  (polar Pd1 (+ (angle Pd1 CCC) (/ pi 2)) 1))<br />   (setq Pe1 (Tri:Isogonal-Conjugate-Point-1 Pe Pa Pb InC))<br />   (ELL:5PEllipse pa pb pc pd pe1)<br /> )<br /> ;;;----------------------------------------------------;<br /> ;;;定比点                                              ;<br /> ;;;----------------------------------------------------;<br /> (defun Mat:Proportion (k p1 p2)<br />   (mapcar (function (lambda (u v) (+ u (* k (- v u))))) p1 p2)<br /> )<br /> ;;;----------------------------------------------------;<br /> ;;;两矢量的点积                                        ;<br /> ;;;----------------------------------------------------;<br /> (defun Mat:Dot (v1 v2)<br />   (apply '+ (mapcar '* v1 v2))<br /> )<br /> ;;;----------------------------------------------------;<br /> ;;;镜像点                                              ;<br /> ;;;----------------------------------------------------;<br /> (defun Mat:MirrorPoint (P P1 p2 / v1 v2 d1 p3 p4)<br />   (if (equal p1 p2 1e-8)<br />     (Mat:Proportion 2 p p1)<br />     (setq v1 (mapcar '- p p1)<br />    v2 (mapcar '- p2 p1)<br />    d1 (distance p1 p2)<br />    p3 (Mat:Proportion (/ (Mat:Dot v1 v2) d1 d1) p1 p2)<br />    p4 (Mat:Proportion 2 p p3)<br />     )    <br />   ) <br /> )<br /> ;;;----------------------------------------------------;<br /> ;;;三角形外心                                          ;<br /> ;;;----------------------------------------------------;<br /> (defun Tri:CircumCenter (Pa Pb Pc / Vb Vc Bx By Cx Cy BB CC D)<br />   (setq Vb (mapcar '- Pb Pa))<br />   (setq Vc (mapcar '- Pc Pa))<br />   (setq Bx (car  Vb))<br />   (setq By (cadr Vb))<br />   (setq Cx (car  Vc))<br />   (setq Cy (cadr Vc))<br />   (setq BB (+ (* Bx Bx) (* By By)))<br />   (setq CC (+ (* Cx Cx) (* Cy Cy)))<br />   (setq D  (- (* Bx Cy) (* By Cx)))<br />   (setq D  (+ D D))<br />   (if (/= D 0.0)<br />     (progn <br />       (setq dx (/ (- (* Cy BB) (* By CC)) D))<br />       (setq dy (/ (- (* Bx CC) (* Cx BB)) D))<br />       (mapcar '+ Pa (list dx dy))<br />     )<br />   )<br /> )<br /> ;;;----------------------------------------------------;<br /> ;;;三角形内心                                          ;<br /> ;;;----------------------------------------------------;<br /> (defun Tri:InCenter (pa pb pc / a b c p q)<br />   (setq a (distance pb pc))<br />   (setq b (distance pc pa))<br />   (setq c (distance pa pb))<br />   (setq p (Mat:Proportion (/ b (+ b c)) pc pb))<br />   (setq q (Mat:Proportion (/ a (+ a c)) pc pa))<br />   (inters pa p pb q)<br /> )<br /> ;;;----------------------------------------------------;<br /> ;;;等角共轭点                                          ;<br /> ;;;----------------------------------------------------;<br /> (defun Tri:Isogonal-Conjugate-Point (Pt Pa Pb Pc / Pt1 Pt2 Inc)<br />   (setq InC (Tri:InCenter Pa Pb Pc))<br />   (setq Pt1 (Mat:MirrorPoint Pt Pa Inc))<br />   (setq pt2 (Mat:MirrorPoint Pt Pb Inc))<br />   (inters Pa Pt1 Pb Pt2 nil)<br /> )<br /> ;;;----------------------------------------------------;<br /> ;;;如果已知三角形内心，则可以简略计算                  ;<br /> ;;;----------------------------------------------------;<br /> (defun Tri:Isogonal-Conjugate-Point-1 (Pt Pa Pb Inc / Pt1 Pt2)<br />   (setq Pt1 (Mat:MirrorPoint Pt Pa Inc))<br />   (setq Pt2 (Mat:MirrorPoint Pt Pb Inc))<br />   (inters Pa Pt1 Pb Pt2 nil)<br /> )<br /> ;;;测试程序<br /> (defun c:test7 (/ pa pb pc pd ret)<br />   (initget 1)<br />   (setq pa (getpoint "\n输入第一点:"))<br />   (initget 1)<br />   (setq pb (getpoint "\n输入第二点:"))<br />   (initget 1)<br />   (setq pc (getpoint "\n输入第三点:"))<br />   (initget 1)<br />   (setq pd (getpoint "\n输入映射点:"))<br />   <br />   (Ent:Make-Poly (list pa pb pc pd))<br />   (setq ret (Ell:NearToCircleEllipse Pd pa pb pc))<br />   (and ret (apply 'Ell:Make-Ellipse ret))<br /> <br />   (princ)<br /> )<br />

十二 椭圆JIG教程
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=66579

十三 椭圆的UCS投影
http://www.theswamp.org/index.php?topic=43031.0
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=84527
下面为相关程序：


十四 椭圆和多段线转化
如果以前系统变量pellipse设置为1时候画的椭圆，现在想转化为CAD的椭圆实体，则可以用如下程序。

1. ;;;把以前用多段线画的椭圆改成真实的椭圆。
   
2. (defun ELL:GetEllipseFromPoly (poly / pts pt0 pt1 pt2 pt3 cen a b rat maj)
   
3.   (defun Get-3dpoly-Coordinates (poly / v e l)
   
4.     (setq v (entnext poly))
   
5.     (while (/= (cdr (assoc 0 (setq e (entget v)))) "SEQEND")
   
6.       (setq l (cons (cdr (assoc 10 e)) l)
   
7.             v (entnext v)
   
8.       )
   
9.     )
   
10.     (reverse l)
    
11.   )
    
12.   (setq pts (Get-3dpoly-Coordinates poly))
    
13.   (setq pt0 (car pts))
    
14.   (setq pt1 (nth 4 pts))
    
15.   (setq pt2 (nth 8 pts))
    
16.   (setq pt3 (nth 12 pts))
    
17.   (setq cen (mapcar '* (mapcar '+ pt0 pt2) '(0.5 0.5 0.5)))
    
18.   (setq a   (distance cen pt0))
    
19.   (setq b   (distance cen pt1))
    
20.   (setq rat (/ b a))
    
21.   (setq maj (mapcar '- pt0 cen))
    
22.   (list cen maj rat)
    
23. )
    
24. ;;;测试程序
    
25. (defun c:test5(/ pl ret)
    
26.   (setq pl  (car (entsel)))
    
27.   (setq ret (ELL:GetEllipseFromPoly pl))
    
28.   (entmakeX
    
29.     (list
    
30.       '(0 . "ELLIPSE")
    
31.       '(100 . "AcDbEntity")
    
32.       '(100 . "AcDbEllipse")
    
33.       (cons 10 (car ret))
    
34.       (cons 11 (cadr ret))
    
35.       (cons 40 (caddr ret))
    
36.     )
    
37.   )
    
38.   (princ)
    
39. )
    

;;;把以前用多段线画的椭圆改成真实的椭圆。<br /> (defun ELL:GetEllipseFromPoly (poly / pts pt0 pt1 pt2 pt3 cen a b rat maj)<br />   (defun Get-3dpoly-Coordinates (poly / v e l)<br />     (setq v (entnext poly))<br />     (while (/= (cdr (assoc 0 (setq e (entget v)))) "SEQEND")<br />       (setq l (cons (cdr (assoc 10 e)) l)<br />             v (entnext v)<br />       )<br />     )<br />     (reverse l)<br />   )<br />   (setq pts (Get-3dpoly-Coordinates poly))<br />   (setq pt0 (car pts))<br />   (setq pt1 (nth 4 pts))<br />   (setq pt2 (nth 8 pts))<br />   (setq pt3 (nth 12 pts))<br />   (setq cen (mapcar '* (mapcar '+ pt0 pt2) '(0.5 0.5 0.5)))<br />   (setq a   (distance cen pt0))<br />   (setq b   (distance cen pt1))<br />   (setq rat (/ b a))<br />   (setq maj (mapcar '- pt0 cen))<br />   (list cen maj rat)<br /> )<br /> ;;;测试程序<br /> (defun c:test5(/ pl ret)<br />   (setq pl  (car (entsel)))<br />   (setq ret (ELL:GetEllipseFromPoly pl))<br />   (entmakeX<br />     (list<br />       '(0 . "ELLIPSE")<br />       '(100 . "AcDbEntity")<br />       '(100 . "AcDbEllipse")<br />       (cons 10 (car ret))<br />       (cons 11 (cadr ret))<br />       (cons 40 (caddr ret))<br />     )<br />   )<br />   (princ)<br /> )<br />

相反转化则较为简单，设置pellipse系统变量为1，在CAD命令下重新构建那个椭圆则可。

十五  椭圆周长和面积问题
关于周长问题，可以参考如下帖子。
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=82654&page=1#pid434059
面积问题则较为简单，可以用Pi*a*b计算出来。或者用vla-get-area得出结果。

tomonkey239

tanjurun 发表于 2021-1-19 08:53
highflybir  的胸怀，所公开的内容没有留一手，并很热心帮助明经上的朋友，热心免费提供源代码
向 highfly ...

的确，值得钦佩。。。。

tanjurun

highflybir  的胸怀，所公开的内容没有留一手，并很热心帮助明经上的朋友，热心免费提供源代码
向 highflybir  致敬

zst1978

highflybir  是中国公开研究和发表很多椭圆相关高精尖知识的大师

zdqwy19

实用性很高！

hpy

实在是太好了。谢谢！

ynhh

highflybir  是中国公开研究和发表很多椭圆相关高精尖知识的大师
最宝贵的是
highflybir  的胸怀，所公开的内容没有留一手，并很热心帮助明经上的朋友，热心免费提供源代码
向 highflybir  致敬
highflybir  

gufeng

非常完整的资料

zwwen

很好，刚好想要一个描图的命令，把近似椭圆的多段线用椭圆画出来，有了这个资料，就有希望了。谢谢！

wowan1314

支持。

smartstar

谢谢大师的无私。

仲文玉

仰视高飞大师，

highflybird

在几何算法版块中，有很多题目跟椭圆有关。大家如果有兴趣的画，可以去看看。