用LISP绘制精确的抛物线和双曲线

Highflybird

首先说一下，圆锥曲线在CAD中是有精确画法的。可以不用拟合方式或者很多个顶点的多段线模拟绘制。
这样绘制出来的抛物线是样条曲线，仅仅用三个控制点，就能满足高精度要求。
关于这个精确画法，请参考我的下面的帖子：圆锥曲线在AutoCAD的精确表达法

因此根据这个画法，在这篇帖子里，对抛物线，我提供了三种画法的LISP程序：

请点击此处下载

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

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

文件名称:圆锥曲线研究.lsp 
下载次数:18  文件大小:25.79 KB  售价:20D豆 [记录]
下载权限: 不限 以上  [免费赚D豆]

下面是其动画演示：


三点式的核心代码如下：

1. ;;;=============================================================
   
2. ;;; 功能: 根据抛物线上三点获取获取圆锥曲线参数                  
   
3. ;;; 输入: 抛物线上三点p1,p2,p3 （点表，至少二维）               
   
4. ;;; 输出: CAD中的抛物线的三点　　　　　　　　　　　　　　　   　
   
5. ;;;=============================================================
   
6. (defun MATH:GetArgumentsBy3P (p1 p2 p3 / A B C DX1 DX2 DX3 DY1
   
7.             DY2 DY3 Q1 Q2 Q3 X1 X2 X3 Y1 Y2 Y3)
   
8.   (mapcar 'set '(p1 p2 p3) (ALG:Sort3PbyX p1 p2 p3))
   
9.   (mapcar 'set '(x1 x2 x3) (mapcar 'car (list p1 p2 p3)))
   
10.   (mapcar 'set '(y1 y2 y3) (mapcar 'cadr (list p1 p2 p3)))
    
11.   (if (not (GEO:Colinearity p1 p2 p3))
    
12.     (setq dx1 (- x1 x2)
    
13.     dx2 (- x2 x3)
    
14.     dx3 (- x3 x1)
    
15.     dy1 (- y1 y2)
    
16.     dy2 (- y2 y3)
    
17.     dy3 (- y3 y1)
    
18.     dx1 (float dx1)
    
19.     A   (/ (- (* dx1 dy2) (* dx2 dy1)) (* dx1 dx2 dx3))
    
20.     B   (- (/ dy1 dx1) (* A (+ x1 x2)))
    
21.           C   (- y1 (* A x1 x1) (* B x1))
    
22.           q1  (polar p1 (atan (+ (* 2 A x1) B)) 666)
    
23.           q3  (polar p3 (atan (+ (* 2 A x3) B)) 666)
    
24.           q2  (list p1 (inters p1 q1 p3 q3 nil) p3 1)
    
25.     )
    
26.   )
    
27. )
    
28. 
    
29. ;;;=============================================================
    
30. ;;; 功能: 根据抛物线系数获取圆锥曲线参数                        
    
31. ;;; 输入: 抛物线系数a,b,c和上下界m,n以及相对点（插入点）        
    
32. ;;; 输出: 抛物线的两端点及其切线交点                           
    
33. ;;;=============================================================
    
34. (defun MATH:GetArgumentsByEquation (a b c m n p / P1 P2 P3 Q1 Q3)
    
35.   (setq p1 (list m (+ (* m m a) (* b m) c) 0.0))
    
36.   (setq p3 (list n (+ (* n n a) (* b n) c) 0.0))
    
37.   (setq q1 (polar p1 (atan (+ (* 2 a m) b)) 666))
    
38.   (setq q3 (polar p3 (atan (+ (* 2 a n) b)) 666))
    
39.   (if (setq p2 (inters p1 q1 p3 q3 nil))
    
40.     (list (mapcar '+ p p1) (mapcar '+ p p2) (mapcar '+ p p3) 1)
    
41.   )
    
42. )

;;;=============================================================<br /> ;;; 功能: 根据抛物线上三点获取获取圆锥曲线参数                  <br /> ;;; 输入: 抛物线上三点p1,p2,p3 （点表，至少二维）               <br /> ;;; 输出: CAD中的抛物线的三点　　　　　　　　　　　　　　　   　<br /> ;;;=============================================================<br /> (defun MATH:GetArgumentsBy3P (p1 p2 p3 / A B C DX1 DX2 DX3 DY1<br />             DY2 DY3 Q1 Q2 Q3 X1 X2 X3 Y1 Y2 Y3)<br />   (mapcar 'set '(p1 p2 p3) (ALG:Sort3PbyX p1 p2 p3))<br />   (mapcar 'set '(x1 x2 x3) (mapcar 'car (list p1 p2 p3)))<br />   (mapcar 'set '(y1 y2 y3) (mapcar 'cadr (list p1 p2 p3)))<br />   (if (not (GEO:Colinearity p1 p2 p3))<br />     (setq dx1 (- x1 x2)<br />     dx2 (- x2 x3)<br />     dx3 (- x3 x1)<br />     dy1 (- y1 y2)<br />     dy2 (- y2 y3)<br />     dy3 (- y3 y1)<br />     dx1 (float dx1)<br />     A   (/ (- (* dx1 dy2) (* dx2 dy1)) (* dx1 dx2 dx3))<br />     B   (- (/ dy1 dx1) (* A (+ x1 x2)))<br />           C   (- y1 (* A x1 x1) (* B x1))<br />           q1  (polar p1 (atan (+ (* 2 A x1) B)) 666)<br />           q3  (polar p3 (atan (+ (* 2 A x3) B)) 666)<br />           q2  (list p1 (inters p1 q1 p3 q3 nil) p3 1)<br />     )<br />   )<br /> )<br /> <br /> ;;;=============================================================<br /> ;;; 功能: 根据抛物线系数获取圆锥曲线参数                        <br /> ;;; 输入: 抛物线系数a,b,c和上下界m,n以及相对点（插入点）        <br /> ;;; 输出: 抛物线的两端点及其切线交点                            <br /> ;;;=============================================================<br /> (defun MATH:GetArgumentsByEquation (a b c m n p / P1 P2 P3 Q1 Q3)<br />   (setq p1 (list m (+ (* m m a) (* b m) c) 0.0))<br />   (setq p3 (list n (+ (* n n a) (* b n) c) 0.0))<br />   (setq q1 (polar p1 (atan (+ (* 2 a m) b)) 666))<br />   (setq q3 (polar p3 (atan (+ (* 2 a n) b)) 666))<br />   (if (setq p2 (inters p1 q1 p3 q3 nil))<br />     (list (mapcar '+ p p1) (mapcar '+ p p2) (mapcar '+ p p3) 1)<br />   )<br /> )

下面我继续介绍如何画双曲线：
经过研究，形成双曲线spline的三点对于P1,P3是容易得到的。对于P2点按照如下方式计算：


其中p2的权重取值为x/a.
其实当x取一些特殊值的时候，容易得到更简易的画法，譬如当x=2a的时候，以a=5,b=3为例，画法如下：


下面是用程序画出双曲线的演示：


双曲线的核心代码如下：

1. ;;;=============================================================
   
2. ;;; 功能: 获取圆锥曲线参数的子函数                              
   
3. ;;; 参数: 两个半轴长度la,lb和中心坐标cx,cy以及四点X值，是否Y对称
   
4. ;;; 返回: 两条SPLINE的参数（三个点和权重）                     
   
5. ;;;-------------------------------------------------------------
   
6. (defun Ent:GetSplineOfConic (la lb cx cy x1 x2 x3 x4 isY /
   
7.                              d1 d2 d3 d4 px py qx qy mx nx wt)
   
8.   (setq d1 (abs (- x1 cx)))
   
9.   (setq d2 (abs (- x2 cx)))
   
10.   (setq d3 (abs (- x3 cx)))
    
11.   (setq d4 (abs (- x4 cx)))
    
12.   (setq px (max d1 d2 d3 d4))                                        ;起点X值
    
13.   (setq wt (/ px la))                                                ;第二点权重
    
14.   (setq py (* lb (sqrt (1- (* wt wt)))))                        ;起点Y值-->此处要检查能否开平方?
    
15.   (setq mx (/ la wt))                                                ;控制点坐标
    
16.   (setq Qy (- cy py))
    
17.   (setq Py (+ cy py))
    
18.   (setq Qx (- cx px))
    
19.   (setq Px (+ cx px))
    
20.   (setq Nx (- cx mx))
    
21.   (setq Mx (+ cx mx))
    
22.   (if isY
    
23.     (list
    
24.       (list (list py px) (list cy mx) (list qy px) wt)
    
25.       (list (list py qx) (list cy nx) (list qy qx) wt)
    
26.     )
    
27.     (list
    
28.       (list (list px py) (list mx cy) (list px qy) wt)
    
29.       (list (list qx py) (list nx cy) (list qx qy) wt)
    
30.     )
    
31.   )
    
32. )

;;;=============================================================<br /> ;;; 功能: 获取圆锥曲线参数的子函数                              <br /> ;;; 参数: 两个半轴长度la,lb和中心坐标cx,cy以及四点X值，是否Y对称<br /> ;;; 返回: 两条SPLINE的参数（三个点和权重）                      <br /> ;;;-------------------------------------------------------------<br /> (defun Ent:GetSplineOfConic (la lb cx cy x1 x2 x3 x4 isY /<br />                              d1 d2 d3 d4 px py qx qy mx nx wt) <br />   (setq d1 (abs (- x1 cx)))<br />   (setq d2 (abs (- x2 cx)))<br />   (setq d3 (abs (- x3 cx)))<br />   (setq d4 (abs (- x4 cx)))<br />   (setq px (max d1 d2 d3 d4))                                        ;起点X值<br />   (setq wt (/ px la))                                                ;第二点权重<br />   (setq py (* lb (sqrt (1- (* wt wt)))))                        ;起点Y值-->此处要检查能否开平方?<br />   (setq mx (/ la wt))                                                ;控制点坐标<br />   (setq Qy (- cy py))<br />   (setq Py (+ cy py))<br />   (setq Qx (- cx px))<br />   (setq Px (+ cx px))<br />   (setq Nx (- cx mx))<br />   (setq Mx (+ cx mx))<br />   (if isY<br />     (list<br />       (list (list py px) (list cy mx) (list qy px) wt)<br />       (list (list py qx) (list cy nx) (list qy qx) wt)<br />     )<br />     (list<br />       (list (list px py) (list mx cy) (list px qy) wt)<br />       (list (list qx py) (list nx cy) (list qx qy) wt)<br />     )<br />   )<br /> )

其它具体实现细节请参见附件。

注明：此代码开源，不得做商业用途。转载需注明出处。

ynhh

请教高飞大师
您这GIF动画是用什么程序录制的？
能不能上传分享一下。
谢谢

Highflybird

ynhh 发表于 2021-9-9 10:53
请教高飞大师
您这GIF动画是用什么程序录制的？
能不能上传分享一下。

screenToGIF，网上一搜就出来了。
screentoGIF官网

ynhh

Highflybird 发表于 2021-9-9 11:44
screenToGIF，网上一搜就出来了。
screentoGIF官网

谢谢您的热心帮助和指导

tzfcn

很好的代码，值得学习、推广。

Michael527

谢谢分享，值得收藏的代码

tigcat

感谢高飞大神分享知识.

yangjian001

做一个热心并受欢迎的人

60ck

很棒的代碼，值的收藏
謝謝您的分享

1028882406@qq.c

谢谢高版主   不错学习了

Backkom

是回复可见吗