【求助】怎样求得直线和椭圆的交点

nonsmall

9楼的办法就是计算麻烦点，不过转换程序倒不麻烦。谢谢先。

hhc

有一个简单的方法:将直线作为边界来剪切椭圆,然后检查椭圆是否发生了改变(如起点及终点角度是否与原来不一样),如果改变了,说明有交点,然后再undo回去.也可以将椭圆作为边界来剪切直线,然后检查直线长度是否发生了变化.

  但这种方法检查不出相切的情况

nonsmall

方法倒是挺独特的,但是如果线和椭圆只有一个交点的情况就不行了(不相切但穿过一条边)

无痕

我数学不行,关注一下:)

zml84

买了cad（就算它是盗版的），那它就是被用来干活啊！
如果求交点还要自己算，那还用它作甚？！

下面代码，没有使用vl系列函数。

3. ;;;======================================
4. ;;;函数名：JD
5. ;;;功能：求一直线与其它图元的交叉点坐标。
6. ;;;编写时间：2006-09-28
7. ;;;======================================
8. (defun C:jd (/)
9. ;;;1、提示用户选取对象
10.   (while
11.     (= (setq el (entsel "\n请点选直线对象: "))
12.        nil
13.     )
14.   )
15.   (princ "\n****请选择待求交点的对象**** ")
16.   (while (= (setq s1 (ssget)) nil)
17.     (princ "\n**未选择对象，请选择待求交点的对象** ")
18.   )
19. ;;;2、记录直线起终点坐标
20.   (setq    ob_line    (car el) ;_获取对象名
21.     ent    (entget ob_line)
22.     pt0_old    (cdr (assoc '10 ent))
23.     pt1_old    (cdr (assoc '11 ent))
24.     QD    (list ob_line pt0_old)    ;生成双元表，
25.     ZD    (list ob_line pt1_old)    ;为执行trim或extend准备响应对象
26.   )
27. ;;;3、试着将直线缩短至不与任何选取的对象相交
28.   (setq b1 0) ;_初始化标记。0表示继续；1表示结束
29.   (while (= b1 0)
30.     (command "_trim" s1 "" QD "")
31.     (command "_trim" s1 "" ZD "")
32.     (setq ent (entget ob_line)
33.       pt0 (cdr (assoc '10 ent))
34.       pt1 (cdr (assoc '11 ent))
35.     )
36.     (IF    (AND (equal PT0 PT0_OLD) (equal PT1 PT1_OLD))
37.       (progn                ;如果起终点未变化，表示已修剪至最短，则：
38.     (command "_scale" ob_line "" pt0 0.9) ;对直线对象缩放，
39.     (command "_scale" ob_line "" pt1 0.9) ;以脱离目标对象
40.     (setq ent     (entget ob_line)    ;重新获取其中点坐标
41.           pt0_old (cdr (assoc '10 ent))
42.           pt1_old (cdr (assoc '11 ent))
43.     )
44.     (setq b1 1)
45.       )
46.       (progn                ;否则：
47.     (setq pt0_old pt0
48.           pt1_old pt1
49.     )
50.       )
51.     ) ;_结束IF
52.     (setq QD (list ob_line pt0_old)
53.       ZD (list ob_line pt1_old)
54.     )
55.   ) ;_结束while
56. ;;;4、利用延伸命令，循环探测直线起终点是否改变
57.   (setq list_jd '())            ;建立空表，用于存放交点位置
58.   ;;先延伸直线起点方向
59.   (setq b1 0)
60.   (while (= b1 0)
61.     (command "_extend" s1 "" QD "")
62.     (setq ent (entget ob_line)
63.       pt0 (cdr (assoc '10 ent))
64.     )
65.     ;;判断直线起点是否变化
66.     (IF    (equal PT0 PT0_OLD)
67.       (setq b1 1)
68.       (setq list_jd (cons pt0 list_jd)
69.         pt0_old pt0
70.         QD        (list ob_line pt0_old)
71.       )
72.     ) ;_结束IF
73.   ) ;_结束while
74.   ;;延伸直线终点方向
75.   (setq b1 0)
76.   (while (= b1 0)
77.     (command "_extend" s1 "" ZD "")
78.     (setq ent (entget ob_line)
79.       pt1 (cdr (assoc '11 ent))
80.     )
81.     ;;判断直线终点是否变化
82.     (IF    (equal PT1 PT1_OLD)
83.       (setq b1 1)
84.       (setq list_jd (append list_jd (list pt1))
85.         pt1_old pt1
86.         ZD        (list ob_line pt1_old)
87.       )
88.     )                    ;结束IF
89.   ) ;_结束while
90. ;;;5、结果显示输出
91.   (setq i 0)
92.   (princ "\n直线与其它所选对象的交点坐标如下:")
93.   (repeat (length list_jd)        ;重复次数为表中成员数。
94.     (print (nth i list_jd))        ;打印当前成员后换行 。
95.     (setq i (1+ i))            ;计数器加1。
96.   )
97.   (princ "\n命令成功完成！")
98.   (princ)
99. )

;;;====================================== ;;;函数名：JD ;;;功能：求一直线与其它图元的交叉点坐标。 ;;;编写时间：2006-09-28 ;;;====================================== (defun C:jd (/) ;;;1、提示用户选取对象   (while     (= (setq el (entsel "\n请点选直线对象: "))        nil     )   )   (princ "\n****请选择待求交点的对象**** ")   (while (= (setq s1 (ssget)) nil)     (princ "\n**未选择对象，请选择待求交点的对象** ")   ) ;;;2、记录直线起终点坐标   (setq    ob_line    (car el) ;_获取对象名     ent    (entget ob_line)     pt0_old    (cdr (assoc '10 ent))     pt1_old    (cdr (assoc '11 ent))     QD    (list ob_line pt0_old)    ;生成双元表，     ZD    (list ob_line pt1_old)    ;为执行trim或extend准备响应对象   ) ;;;3、试着将直线缩短至不与任何选取的对象相交   (setq b1 0) ;_初始化标记。0表示继续；1表示结束   (while (= b1 0)     (command "_trim" s1 "" QD "")     (command "_trim" s1 "" ZD "")     (setq ent (entget ob_line)       pt0 (cdr (assoc '10 ent))       pt1 (cdr (assoc '11 ent))     )     (IF    (AND (equal PT0 PT0_OLD) (equal PT1 PT1_OLD))       (progn                ;如果起终点未变化，表示已修剪至最短，则：     (command "_scale" ob_line "" pt0 0.9) ;对直线对象缩放，     (command "_scale" ob_line "" pt1 0.9) ;以脱离目标对象     (setq ent     (entget ob_line)    ;重新获取其中点坐标           pt0_old (cdr (assoc '10 ent))           pt1_old (cdr (assoc '11 ent))     )     (setq b1 1)       )       (progn                ;否则：     (setq pt0_old pt0           pt1_old pt1     )       )     ) ;_结束IF     (setq QD (list ob_line pt0_old)       ZD (list ob_line pt1_old)     )   ) ;_结束while ;;;4、利用延伸命令，循环探测直线起终点是否改变   (setq list_jd '())            ;建立空表，用于存放交点位置   ;;先延伸直线起点方向   (setq b1 0)   (while (= b1 0)     (command "_extend" s1 "" QD "")     (setq ent (entget ob_line)       pt0 (cdr (assoc '10 ent))     )     ;;判断直线起点是否变化     (IF    (equal PT0 PT0_OLD)       (setq b1 1)       (setq list_jd (cons pt0 list_jd)         pt0_old pt0         QD        (list ob_line pt0_old)       )     ) ;_结束IF   ) ;_结束while   ;;延伸直线终点方向   (setq b1 0)   (while (= b1 0)     (command "_extend" s1 "" ZD "")     (setq ent (entget ob_line)       pt1 (cdr (assoc '11 ent))     )     ;;判断直线终点是否变化     (IF    (equal PT1 PT1_OLD)       (setq b1 1)       (setq list_jd (append list_jd (list pt1))         pt1_old pt1         ZD        (list ob_line pt1_old)       )     )                    ;结束IF   ) ;_结束while ;;;5、结果显示输出   (setq i 0)   (princ "\n直线与其它所选对象的交点坐标如下:")   (repeat (length list_jd)        ;重复次数为表中成员数。     (print (nth i list_jd))        ;打印当前成员后换行 。     (setq i (1+ i))            ;计数器加1。   )   (princ "\n命令成功完成！")   (princ) )

狂刀无痕

估计不愿意用vl的更不愿意用comand了

nonsmall

晕晕中

汗!

办法真是千奇百怪又好玩.

但,如果线的端点正好在椭圆上延伸就不好使了吧?

highflybir

尽管这个题可以用各种方法，用vla-intersectwith最简单，核心代码仅仅几行。用Command的方法可以完成。但耗时多。

我上面提供了用计算几何方式的做法，经测试，编译后其速度比用vla-intersectwith快5-10倍。

虽然用计算几何的步骤麻烦，但如果是大量运算的话，其优势体现出来了。

不过每个方法都有优缺点。不知道楼主究竟是在什么情况下要求这个算法？

无痕

不错,编译后好像更明显.比用vla快一倍

ivde

反了吧？

命令: test
请选择椭圆:
请选择直线:
It spent 27.991 seconds to run this routine.

It spent 15.692 seconds to run Intersect routine.

2. (Defun C:Test (/ ent1 lst1 ent2 lst2 obj1 obj2 t0 pts)
3.   (if (And (Setq Ent1 (Car (Entsel "\n请选择椭圆:")))
4.        (Setq Lst1 (Entget Ent1))
5.        (= (Cdr (Assoc 0 Lst1)) "ELLIPSE")
6.        (Setq Ent2 (Car (Entsel "\n请选择直线:")))
7.        (Setq Lst2 (Entget Ent2))
8.        (= (Cdr (Assoc 0 Lst2)) "LINE")
9.       )
10.     (Progn
11.       (Setq Obj1 (Vlax-Ename->vla-Object Ent1)
12.         Obj2 (Vlax-Ename->vla-Object Ent2)
13.       )
14.       ;;用计算几何法求
15.       (Setq T0 (Getvar "TDUSRTIMER"))
16.       (Repeat 100000
17.     (Setq Pts (Get-Intersect-Ellipse-And-Line))
18.       )
19.       (Princ "\nIt spent ")
20.       (Princ (* (- (Getvar "TDUSRTIMER") T0) 86400))
21.       (Princ " seconds to run this routine.\n")
22.       ;;用VBA法求
23.       (Setq T0 (Getvar "TDUSRTIMER"))
24.       (Repeat 100000
25.     (setq pts (Get-Intersect-Ellipse-And-Line-1))
26.       )
27.       (Princ "\nIt spent ")
28.       (Princ (* (- (Getvar "TDUSRTIMER") T0) 86400))
29.       (Princ " seconds to run Intersect routine.\n")
30.     )
31.   )
32.   (Princ)
33. )
34. ;;;Intersectwith方式
35. (Defun Get-Intersect-Ellipse-And-Line-1    (/ pts ptl)
36.   (if (Setq pts (vlax-invoke obj1 'Intersectwith Obj2 Acextendnone))
37.     (while pts
38.       (setq ptl    (cons (list (car pts) (cadr pts) (caddr pts)) ptl)
39.         pts    (cdddr pts)
40.       )
41.     )
42.   )
43. )
44. ;;;计算几何方式
45. (Defun Get-Intersect-Ellipse-And-Line (/   Cen P0x P0y Rat R   An1 SSS
46.                        CCC Stp Edp Pm  LL  P1  P2  P3
47.                        P4  P5  X1  Y1  X2  Y2  A   B
48.                        C   D   E   An
49.                       )
50.   (Get-Ellipse-Parameters Lst1)        ;椭圆的参数
51.   (Get-Line-Parameters Lst2)        ;线段的参数
52.   (Setq    P1 (Transfer Stp)        ;变换线段起点
53.     P2 (Transfer Edp)        ;变换线段终点
54.     X1 (Car P1)
55.     Y1 (Cadr P1)
56.     X2 (Car P2)
57.     Y2 (Cadr P2)
58.     A  (- Y1 Y2)            ;直线方程系数A
59.     B  (- X2 X1)            ;直线方程系数B
60.     C  (- (* Y2 X1) (* Y1 X2))    ;直线方程系数C
61.     D  (/ C (Sqrt (+ (* A A) (* B B))))
62.   )                    ;中心到直线距离
63. &#160; (if (< (Abs D) (+ R 1e-8))&#160;&#160; &#160;&#160;&#160; &#160;;如果大于半径(长轴)
64. &#160;&#160;&#160; (Progn
65. &#160;&#160;&#160;&#160;&#160; (Setq E&#160; (Sqrt (Abs (- (* R R) (* D D)))) ;半弦长
66. &#160;&#160; &#160;&#160;&#160;&#160; An (Angle P1 P2)&#160;&#160; &#160;&#160;&#160; &#160;;线段的角度
67. &#160;&#160; &#160;&#160;&#160;&#160; P3 (Polar '(0 0) (- An (/ Pi 2)) D) ;垂足点
68. &#160;&#160; &#160;&#160;&#160;&#160; P4 (Polar P3 An E)&#160;&#160; &#160;&#160;&#160; &#160;;交点1
69. &#160;&#160; &#160;&#160;&#160;&#160; P5 (Polar P3 An (- E))&#160;&#160; &#160;;交点2
70. &#160;&#160; &#160;&#160;&#160;&#160; LL (+ (/ (Distance P1 P2) 2) 1e-6) ;线段的半长
71. &#160;&#160; &#160;&#160;&#160;&#160; Pm (List (/ (+ X1 X2) 2)&#160;&#160; &#160;;线段的中点
72. &#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160; (/ (+ Y1 Y2) 2)
73. &#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160; )
74. &#160;&#160;&#160;&#160;&#160; )
75. &#160;&#160;&#160;&#160;&#160; (Cond&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;;判断到中点的距离
76. &#160;&#160; &#160;((And (> (Distance P4 Pm) LL)&#160;&#160; &#160;;如果都大于线段的半长
77. &#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160; (> (Distance P5 Pm) LL)
78. &#160;&#160; &#160; )
79. &#160;&#160; &#160; nil&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;;则没有交点
80. &#160;&#160; &#160;)
81. &#160;&#160; &#160;((> (Distance P4 Pm) LL)
82. &#160;&#160; &#160; (List (Retransfer P5))&#160;&#160; &#160;&#160;&#160; &#160;;有一个交点
83. &#160;&#160; &#160;)
84. &#160;&#160; &#160;((> (Distance P5 Pm) LL)
85. &#160;&#160; &#160; (List (Retransfer P4))&#160;&#160; &#160;&#160;&#160; &#160;;有一个交点
86. &#160;&#160; &#160;)
87. &#160;&#160; &#160;(T
88. &#160;&#160; &#160; (List&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;;有两个交点
89. &#160;&#160; &#160;&#160;&#160; (Retransfer P4)
90. &#160;&#160; &#160;&#160;&#160; (Retransfer P5)
91. &#160;&#160; &#160; )
92. &#160;&#160; &#160;)
93. &#160;&#160;&#160;&#160;&#160; )
94. &#160;&#160;&#160; )
95. &#160; )
96. )
97. (Defun Get-Ellipse-Parameters (Lst / Xpt)
98. &#160; (Setq&#160;&#160; &#160;Cen (Cdr (Assoc 10 Lst))&#160;&#160; &#160;;中心
99. &#160;&#160; &#160;P0x (Car Cen)
100. &#160;&#160; &#160;P0y (Cadr Cen)
101. &#160;&#160; &#160;Xpt (Cdr (Assoc 11 Lst))&#160;&#160; &#160;;长轴方向
102. &#160;&#160; &#160;Rat (Cdr (Assoc 40 Lst))&#160;&#160; &#160;;比率
103. &#160;&#160; &#160;R&#160;&#160; (Distance '(0 0) Xpt)&#160;&#160; &#160;;长轴
104. &#160;&#160; &#160;An1 (Angle '(0 0) Xpt)&#160;&#160; &#160;&#160;&#160; &#160;;倾斜角
105. &#160;&#160; &#160;SSS (Sin An1)&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;;倾斜角正弦
106. &#160;&#160; &#160;CCC (Cos An1)
107. &#160; )&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;;倾斜角余弦
108. )
109. (Defun Get-Line-Parameters (Lst /)
110. &#160; (Setq&#160;&#160; &#160;Stp (Cdr (Assoc 10 Lst))&#160;&#160; &#160;;线段的起点
111. &#160;&#160; &#160;Edp (Cdr (Assoc 11 Lst))
112. &#160; )&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;;线段的终点
113. )
114. (Defun Transfer&#160;&#160; &#160;(Pt / Px1 Py1 Px2 Py2 Px3 Py3)
115. &#160; (Setq&#160;&#160; &#160;Px1 (Car Pt)&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;;要变换的点的X坐标
116. &#160;&#160; &#160;Py1 (Cadr Pt)&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;;要变换的点的Y坐标
117. &#160;&#160; &#160;Px2 (- Px1 P0x)&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;;平移变换
118. &#160;&#160; &#160;Py2 (- Py1 P0y)
119. &#160;&#160; &#160;Px3 (+ (* Px2 CCC) (* Py2 SSS))&#160;&#160; &#160;;旋转变换
120. &#160;&#160; &#160;Py3 (- (* Py2 CCC) (* Px2 SSS))
121. &#160;&#160; &#160;Py3 (/ Py3 Rat)
122. &#160; )&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;;比例变换
123. &#160; (List Px3 Py3)
124. )
125. (Defun Retransfer (Pt / Px4 Py4 Px5 Py5 Px6 Py6)
126. &#160; (Setq&#160;&#160; &#160;Px4 (Car Pt)&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;;要变换的点的X坐标
127. &#160;&#160; &#160;Py4 (Cadr Pt)&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;;要变换的点的Y坐标
128. &#160;&#160; &#160;Py4 (* Py4 Rat)&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;;比例变换
129. &#160;&#160; &#160;Px5 (- (* Px4 CCC) (* Py4 SSS))&#160;&#160; &#160;;旋转变换
130. &#160;&#160; &#160;Py5 (+ (* Py4 CCC) (* Px4 SSS))
131. &#160;&#160; &#160;Px6 (+ Px5 P0x)&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;;平移变换
132. &#160;&#160; &#160;Py6 (+ Py5 P0y)
133. &#160; )
134. &#160; (List Px6 Py6)
135. )
136. ;;;画交点
137. (defun Draw-Intersect-Point (pts / pt1 pt2)
138. &#160; (if (Setq Pt1 (Car Pts))
139. &#160;&#160;&#160; (Entmake
140. &#160;&#160;&#160;&#160;&#160; (List
141. &#160;&#160; &#160;(Cons 0 "POINT")
142. &#160;&#160; &#160;(Cons 10 Pt1)
143. &#160;&#160;&#160;&#160;&#160; )
144. &#160;&#160;&#160; )
145. &#160; )
146. &#160; (if (Setq Pt2 (Cadr Pts))
147. &#160;&#160;&#160; (Entmake
148. &#160;&#160;&#160;&#160;&#160; (List
149. &#160;&#160; &#160;(Cons 0 "POINT")
150. &#160;&#160; &#160;(Cons 10 Pt2)
151. &#160;&#160;&#160;&#160;&#160; )
152. &#160;&#160;&#160; )
153. &#160; )
154. )

(Defun C:Test (/ ent1 lst1 ent2 lst2 obj1 obj2 t0 pts) &#160; (if (And (Setq Ent1 (Car (Entsel "\n请选择椭圆:"))) &#160;&#160; &#160;&#160;&#160; (Setq Lst1 (Entget Ent1)) &#160;&#160; &#160;&#160;&#160; (= (Cdr (Assoc 0 Lst1)) "ELLIPSE") &#160;&#160; &#160;&#160;&#160; (Setq Ent2 (Car (Entsel "\n请选择直线:"))) &#160;&#160; &#160;&#160;&#160; (Setq Lst2 (Entget Ent2)) &#160;&#160; &#160;&#160;&#160; (= (Cdr (Assoc 0 Lst2)) "LINE") &#160;&#160;&#160;&#160;&#160; ) &#160;&#160;&#160; (Progn &#160;&#160;&#160;&#160;&#160; (Setq Obj1 (Vlax-Ename->vla-Object Ent1) &#160;&#160; &#160;&#160;&#160;&#160; Obj2 (Vlax-Ename->vla-Object Ent2) &#160;&#160;&#160;&#160;&#160; ) &#160;&#160;&#160;&#160;&#160; ;;用计算几何法求 &#160;&#160;&#160;&#160;&#160; (Setq T0 (Getvar "TDUSRTIMER")) &#160;&#160;&#160;&#160;&#160; (Repeat 100000 &#160;&#160; &#160;(Setq Pts (Get-Intersect-Ellipse-And-Line)) &#160;&#160;&#160;&#160;&#160; ) &#160;&#160;&#160;&#160;&#160; (Princ "\nIt spent ") &#160;&#160;&#160;&#160;&#160; (Princ (* (- (Getvar "TDUSRTIMER") T0) 86400)) &#160;&#160;&#160;&#160;&#160; (Princ " seconds to run this routine.\n") &#160;&#160;&#160;&#160;&#160; ;;用VBA法求 &#160;&#160;&#160;&#160;&#160; (Setq T0 (Getvar "TDUSRTIMER")) &#160;&#160;&#160;&#160;&#160; (Repeat 100000 &#160;&#160; &#160;(setq pts (Get-Intersect-Ellipse-And-Line-1)) &#160;&#160;&#160;&#160;&#160; ) &#160;&#160;&#160;&#160;&#160; (Princ "\nIt spent ") &#160;&#160;&#160;&#160;&#160; (Princ (* (- (Getvar "TDUSRTIMER") T0) 86400)) &#160;&#160;&#160;&#160;&#160; (Princ " seconds to run Intersect routine.\n") &#160;&#160;&#160; ) &#160; ) &#160; (Princ) ) ;;;Intersectwith方式 (Defun Get-Intersect-Ellipse-And-Line-1&#160;&#160; &#160;(/ pts ptl) &#160; (if (Setq pts (vlax-invoke obj1 'Intersectwith Obj2 Acextendnone)) &#160;&#160;&#160; (while pts &#160;&#160;&#160;&#160;&#160; (setq ptl&#160;&#160; &#160;(cons (list (car pts) (cadr pts) (caddr pts)) ptl) &#160;&#160; &#160;&#160;&#160;&#160; pts&#160;&#160; &#160;(cdddr pts) &#160;&#160;&#160;&#160;&#160; ) &#160;&#160;&#160; ) &#160; ) ) ;;;计算几何方式 (Defun Get-Intersect-Ellipse-And-Line (/&#160;&#160; Cen P0x P0y Rat R&#160;&#160; An1 SSS &#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160; CCC Stp Edp Pm&#160; LL&#160; P1&#160; P2&#160; P3 &#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160; P4&#160; P5&#160; X1&#160; Y1&#160; X2&#160; Y2&#160; A&#160;&#160; B &#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160; C&#160;&#160; D&#160;&#160; E&#160;&#160; An &#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160; ) &#160; (Get-Ellipse-Parameters Lst1)&#160;&#160; &#160;&#160;&#160; &#160;;椭圆的参数 &#160; (Get-Line-Parameters Lst2)&#160;&#160; &#160;&#160;&#160; &#160;;线段的参数 &#160; (Setq&#160;&#160; &#160;P1 (Transfer Stp)&#160;&#160; &#160;&#160;&#160; &#160;;变换线段起点 &#160;&#160; &#160;P2 (Transfer Edp)&#160;&#160; &#160;&#160;&#160; &#160;;变换线段终点 &#160;&#160; &#160;X1 (Car P1) &#160;&#160; &#160;Y1 (Cadr P1) &#160;&#160; &#160;X2 (Car P2) &#160;&#160; &#160;Y2 (Cadr P2) &#160;&#160; &#160;A&#160; (- Y1 Y2)&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;;直线方程系数A &#160;&#160; &#160;B&#160; (- X2 X1)&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;;直线方程系数B &#160;&#160; &#160;C&#160; (- (* Y2 X1) (* Y1 X2))&#160;&#160; &#160;;直线方程系数C &#160;&#160; &#160;D&#160; (/ C (Sqrt (+ (* A A) (* B B)))) &#160; )&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;;中心到直线距离 &#160; (if (< (Abs D) (+ R 1e-8))&#160;&#160; &#160;&#160;&#160; &#160;;如果大于半径(长轴) &#160;&#160;&#160; (Progn &#160;&#160;&#160;&#160;&#160; (Setq E&#160; (Sqrt (Abs (- (* R R) (* D D)))) ;半弦长 &#160;&#160; &#160;&#160;&#160;&#160; An (Angle P1 P2)&#160;&#160; &#160;&#160;&#160; &#160;;线段的角度 &#160;&#160; &#160;&#160;&#160;&#160; P3 (Polar '(0 0) (- An (/ Pi 2)) D) ;垂足点 &#160;&#160; &#160;&#160;&#160;&#160; P4 (Polar P3 An E)&#160;&#160; &#160;&#160;&#160; &#160;;交点1 &#160;&#160; &#160;&#160;&#160;&#160; P5 (Polar P3 An (- E))&#160;&#160; &#160;;交点2 &#160;&#160; &#160;&#160;&#160;&#160; LL (+ (/ (Distance P1 P2) 2) 1e-6) ;线段的半长 &#160;&#160; &#160;&#160;&#160;&#160; Pm (List (/ (+ X1 X2) 2)&#160;&#160; &#160;;线段的中点 &#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160; (/ (+ Y1 Y2) 2) &#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160; ) &#160;&#160;&#160;&#160;&#160; ) &#160;&#160;&#160;&#160;&#160; (Cond&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;;判断到中点的距离 &#160;&#160; &#160;((And (> (Distance P4 Pm) LL)&#160;&#160; &#160;;如果都大于线段的半长 &#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160; (> (Distance P5 Pm) LL) &#160;&#160; &#160; ) &#160;&#160; &#160; nil&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;;则没有交点 &#160;&#160; &#160;) &#160;&#160; &#160;((> (Distance P4 Pm) LL) &#160;&#160; &#160; (List (Retransfer P5))&#160;&#160; &#160;&#160;&#160; &#160;;有一个交点 &#160;&#160; &#160;) &#160;&#160; &#160;((> (Distance P5 Pm) LL) &#160;&#160; &#160; (List (Retransfer P4))&#160;&#160; &#160;&#160;&#160; &#160;;有一个交点 &#160;&#160; &#160;) &#160;&#160; &#160;(T &#160;&#160; &#160; (List&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;;有两个交点 &#160;&#160; &#160;&#160;&#160; (Retransfer P4) &#160;&#160; &#160;&#160;&#160; (Retransfer P5) &#160;&#160; &#160; ) &#160;&#160; &#160;) &#160;&#160;&#160;&#160;&#160; ) &#160;&#160;&#160; ) &#160; ) ) (Defun Get-Ellipse-Parameters (Lst / Xpt) &#160; (Setq&#160;&#160; &#160;Cen (Cdr (Assoc 10 Lst))&#160;&#160; &#160;;中心 &#160;&#160; &#160;P0x (Car Cen) &#160;&#160; &#160;P0y (Cadr Cen) &#160;&#160; &#160;Xpt (Cdr (Assoc 11 Lst))&#160;&#160; &#160;;长轴方向 &#160;&#160; &#160;Rat (Cdr (Assoc 40 Lst))&#160;&#160; &#160;;比率 &#160;&#160; &#160;R&#160;&#160; (Distance '(0 0) Xpt)&#160;&#160; &#160;;长轴 &#160;&#160; &#160;An1 (Angle '(0 0) Xpt)&#160;&#160; &#160;&#160;&#160; &#160;;倾斜角 &#160;&#160; &#160;SSS (Sin An1)&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;;倾斜角正弦 &#160;&#160; &#160;CCC (Cos An1) &#160; )&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;;倾斜角余弦 ) (Defun Get-Line-Parameters (Lst /) &#160; (Setq&#160;&#160; &#160;Stp (Cdr (Assoc 10 Lst))&#160;&#160; &#160;;线段的起点 &#160;&#160; &#160;Edp (Cdr (Assoc 11 Lst)) &#160; )&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;;线段的终点 ) (Defun Transfer&#160;&#160; &#160;(Pt / Px1 Py1 Px2 Py2 Px3 Py3) &#160; (Setq&#160;&#160; &#160;Px1 (Car Pt)&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;;要变换的点的X坐标 &#160;&#160; &#160;Py1 (Cadr Pt)&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;;要变换的点的Y坐标 &#160;&#160; &#160;Px2 (- Px1 P0x)&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;;平移变换 &#160;&#160; &#160;Py2 (- Py1 P0y) &#160;&#160; &#160;Px3 (+ (* Px2 CCC) (* Py2 SSS))&#160;&#160; &#160;;旋转变换 &#160;&#160; &#160;Py3 (- (* Py2 CCC) (* Px2 SSS)) &#160;&#160; &#160;Py3 (/ Py3 Rat) &#160; )&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;;比例变换 &#160; (List Px3 Py3) ) (Defun Retransfer (Pt / Px4 Py4 Px5 Py5 Px6 Py6) &#160; (Setq&#160;&#160; &#160;Px4 (Car Pt)&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;;要变换的点的X坐标 &#160;&#160; &#160;Py4 (Cadr Pt)&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;;要变换的点的Y坐标 &#160;&#160; &#160;Py4 (* Py4 Rat)&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;;比例变换 &#160;&#160; &#160;Px5 (- (* Px4 CCC) (* Py4 SSS))&#160;&#160; &#160;;旋转变换 &#160;&#160; &#160;Py5 (+ (* Py4 CCC) (* Px4 SSS)) &#160;&#160; &#160;Px6 (+ Px5 P0x)&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;;平移变换 &#160;&#160; &#160;Py6 (+ Py5 P0y) &#160; ) &#160; (List Px6 Py6) ) ;;;画交点 (defun Draw-Intersect-Point (pts / pt1 pt2) &#160; (if (Setq Pt1 (Car Pts)) &#160;&#160;&#160; (Entmake &#160;&#160;&#160;&#160;&#160; (List &#160;&#160; &#160;(Cons 0 "POINT") &#160;&#160; &#160;(Cons 10 Pt1) &#160;&#160;&#160;&#160;&#160; ) &#160;&#160;&#160; ) &#160; ) &#160; (if (Setq Pt2 (Cadr Pts)) &#160;&#160;&#160; (Entmake &#160;&#160;&#160;&#160;&#160; (List &#160;&#160; &#160;(Cons 0 "POINT") &#160;&#160; &#160;(Cons 10 Pt2) &#160;&#160;&#160;&#160;&#160; ) &#160;&#160;&#160; ) &#160; ) )