又来求救了，一道实际问题提炼出的作图题，sos

明天你好吗

- r7 y5 X$ Q( U8 h+ D
凸面镜反射，已知入射光线上一点与反射光线上一点，如何作入射光线与反射光线
ttachimg]2272051[/attachimg]

woaishuijia

. S- e9 @' i1 {* c7 l  N! I

1.     Dim P1 As Variant, P2 As Variant, P3 As Variant, R As Double
   
2.     Dim B As AcadBlock, C As AcadCircle, L1 As AcadLine, L2 As AcadLine, L3 As AcadLine
   
3.     Dim A As Double, A1 As Double, A2 As Double, A3 As Double, A4 As Double
   & R) g  `9 g" h7 h, }. o
4.     With ThisDrawing
   
5. '操作者屏幕输入参数
   6 l, x  L0 L6 N! ]" X
6.         On Error GoTo 10
   
7.         With .Utility
   6 k' M5 ?6 X  u4 _
8.             P1 = .GetPoint(, "指定圆外第一点")
   . M3 V8 n3 y" z* A/ e. Z. p/ c. l
9.             P2 = .GetPoint(, "指定圆外同侧第二点")
   
10.             P3 = .GetPoint(, "指定圆心")
    $ s5 x( \  g. E/ X. b
11.             R = .GetDistance(P3, "指定半径")
    : _1 _3 \9 L+ F$ v) Z+ T
12.         End With
    ' ?7 y" F* g7 N7 D" _# @
13. '检查输入的参数,如果有一点或两点在圆内部,则退出宏
      z+ G# W; R1 ~" i; F# ^0 c, N
14.         If (P3(0) - P1(0)) ^ 2 + (P3(1) - P1(1)) ^ 2 < R ^ 2 Or (P3(0) - P2(0)) ^ 2 + (P3(1) - P2(1)) ^ 2 < R ^ 2 Then GoTo 10
    
15. '判断作图空间
    9 U, h: W% o; f
16.         If .ActiveSpace = acModelSpace Then
    
17.             Set B = .ModelSpace
    + R' D  E* x; b
18.         Else
    7 ^9 B* E* g3 s4 {" Y
19.             Set B = .PaperSpace
    
20.         End If
    9 g3 m6 ?- d4 M3 _; z  N
21. '按输入参数画圆
    
22.         Set C = B.AddCircle(P3, R)
    . A! y6 F' X) ?) ?2 Y" x* T
23. '在输入的圆外两点间连线
    1 a( t# [( P* z) r6 `
24.         Set L1 = B.AddLine(P2, P1)
    % ^2 k, P) O$ s
25. '检查连线与圆是否相交,如不相交则继续;如相交则删除圆和连线并结束宏
    8 R7 u1 V6 `: E
26.         P3 = C.IntersectWith(L1, acExtendNone)
    
27.         If UBound(P3) = -1 Then
    : M4 q- [. ~* j* s9 X6 |9 p' P
28. '将直线L1的起点改到圆心
    $ R0 m8 e0 e* W( `4 V- L
29.             L1.StartPoint = C.Center
    
30. '从圆心到输入的第二点画直线L2
    0 u! F0 T( [$ E  i. u; C& b
31.             Set L2 = B.AddLine(C.Center, P2)
    
32. '用两直线的角度计算迭代运算的边界
    " \- |: O; R( ~  p: q$ }: R
33.             If L1.Angle - L2.Angle > 0 Then
    2 R+ Z6 v, v% @. M# R/ `& O' P
34.                 If L1.Angle - L2.Angle < .Utility.AngleToReal(180, acDegrees) Then
    3 d3 {) N+ F( ]0 ]& u8 }
35.                     A1 = L1.Angle
    
36.                     A2 = L2.Angle
    ; V, K$ q- E9 b( E4 I6 i4 q4 q
37.                 Else
    
38.                     L1.EndPoint = P2
    " \9 R$ B; {% [0 W) M5 t
39.                     L2.EndPoint = P1
    ' m  S' g4 E1 Y7 L
40.                     A1 = L1.Angle
      l0 v! i$ `7 B% z/ s
41.                     A2 = L2.Angle - 2 * .Utility.AngleToReal(180, acDegrees)
    
42.                 End If
    
43.             Else
    
44.                 If L2.Angle - L1.Angle < .Utility.AngleToReal(180, acDegrees) Then
    - z" k4 e& G6 [. o: m
45.                     L1.EndPoint = P2
    7 V) z& [: C: J& n
46.                     L2.EndPoint = P1
    4 @+ p- h+ [" @8 m: x( S
47.                     A1 = L1.Angle
    
48.                     A2 = L2.Angle
    
49.                 Else
    
50.                     A1 = L1.Angle
    
51.                     A2 = L2.Angle - 2 * .Utility.AngleToReal(180, acDegrees)
    0 h" K& c6 n+ O. [& x
52.                 End If
    
53.             End If
    . S+ J$ h6 {; L
54. '以圆心为起点画第直线L3
    2 E1 c/ ]6 z# h. ~
55.             Set L3 = B.AddLine(C.Center, C.Center)
    0 x4 F) h6 p  D) b$ h' q
56. '循环,迭代运算
    ) \3 y; D+ `, C
57.             Do
    
58. '简单的插值法
    
59.                 A = (A1 + A2) / 2
    
60. '直线L3和入射和反射线的端点改到圆上尝试的点
    
61.                 L3.EndPoint = .Utility.PolarPoint(C.Center, A, R)
    ) r% T7 b4 Y( ?$ {
62.                 L1.StartPoint = L3.EndPoint
    , Z1 }( T' z- c* d  @- O' b
63.                 L2.StartPoint = L3.EndPoint
    
64. '计算入射和反射线分别与直线L3的夹角
    - ]3 G' b  t: z. Q9 N) {7 v
65.                 A3 = L1.Angle - L3.Angle
    9 |/ \, m- h8 {* ~7 [% `8 _3 ]
66.                 If A3 < 0 Then A3 = A3 + 2 * .Utility.AngleToReal(180, acDegrees)
    
67.                 A4 = L3.Angle - L2.Angle
    & _( M* A8 D; Q8 [! W+ o& a
68.                 If A4 < 0 Then A4 = A4 + 2 * .Utility.AngleToReal(180, acDegrees)
    
69. '如果两夹角相等或已运算到浮点数的最高精度则退出循环
    4 C6 ?& @4 L. V% k, h5 ]! s
70. '否则将当前尝试点作为新的边界继续循环运算
    0 z) c2 Q& k9 M$ m( ^& \' d
71.                 If A3 = A4 Or A = A1 Or A = A2 Then
    5 ]. ?9 B/ ~. l. q& n( ?
72.                     Exit Do
    
73.                 ElseIf A3 > A4 Then
    
74.                     A2 = A
    # x. q' x" u- X/ r. r
75.                 Else
    
76.                     A1 = A
    
77.                 End If
    . {) j( m3 B1 [9 s7 X% O0 G
78.             Loop
    
79.         Else
    1 I- }7 \) n( E
80.             C.Delete
    6 W% H2 D- h7 f0 ?  f& q
81.             L1.Delete
    : p9 u4 y1 L/ T3 A* ~4 r
82.             Exit Sub
    - M' \1 }1 Y: }: \- E
83.         End If
    - e, k# k' k$ K- |9 J5 X0 P/ t$ E
84.     End With
    
85. 10:

复制代码

明天你好吗

woaishuijia 发表于 2015-12-25 04:29

来晚了，接收了，版主什么多会。

明天你好吗

woaishuijia 发表于 2015-12-25 04:29

" h0 F' n; |% H0 F" O( E5 s版主大大，发现一个规律。只要以底边两端点为焦点作椭圆与圆相切，那么切点就是所求点。不知这个椭圆能否作出来？

woaishuijia

高次方程，常规作图方法无能为力
死了这条心吧

明天你好吗

woaishuijia 发表于 2016-1-17 02:34
高次方程，常规作图方法无能为力
' i3 B. R. C/ Z; z! V! C死了这条心吧

还想着经常见到的现象能有常规解就好了