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

明天你好吗

凸面镜反射，已知入射光线上一点与反射光线上一点，如何作入射光线与反射光线
9 O$ L  u2 g  Y  _! R1 M2 Xttachimg]2272051[/attachimg]

woaishuijia

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
     Z9 Z7 ^# x( Y" a. }$ u
3.     Dim A As Double, A1 As Double, A2 As Double, A3 As Double, A4 As Double
   
4.     With ThisDrawing
   & e+ Q/ F! L+ ?8 g% x" E
5. '操作者屏幕输入参数
   9 p2 T6 I. v. N* z8 R  }
6.         On Error GoTo 10
   * N% L3 m( ~+ s* `$ l0 |
7.         With .Utility
   , C& f' o! G/ x  y9 t; @. A
8.             P1 = .GetPoint(, "指定圆外第一点")
   
9.             P2 = .GetPoint(, "指定圆外同侧第二点")
   
10.             P3 = .GetPoint(, "指定圆心")
    
11.             R = .GetDistance(P3, "指定半径")
    * l6 `, K7 q* n1 K2 M
12.         End With
    
13. '检查输入的参数,如果有一点或两点在圆内部,则退出宏
    ) K* D) @9 h7 y6 s
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
    * P6 [$ o  f7 \+ I7 F3 \( Z
15. '判断作图空间
    
16.         If .ActiveSpace = acModelSpace Then
    
17.             Set B = .ModelSpace
    + {8 o" O6 d( K2 j( _+ a8 y
18.         Else
    & P7 s  @. A7 D. z, y8 v6 w+ q
19.             Set B = .PaperSpace
    5 v+ P, w3 B3 c% R8 |8 V( Q
20.         End If
    
21. '按输入参数画圆
    
22.         Set C = B.AddCircle(P3, R)
    9 d9 i) f3 I, Q8 O
23. '在输入的圆外两点间连线
    
24.         Set L1 = B.AddLine(P2, P1)
    3 w# q; h; q5 d! W
25. '检查连线与圆是否相交,如不相交则继续;如相交则删除圆和连线并结束宏
    4 d4 x) v* a+ L1 V. q8 P& X: D8 ~
26.         P3 = C.IntersectWith(L1, acExtendNone)
    + B( G! F1 k3 h& R/ [1 Q" T2 c
27.         If UBound(P3) = -1 Then
    
28. '将直线L1的起点改到圆心
    7 D( o" V9 {; M+ L2 Z  W: B
29.             L1.StartPoint = C.Center
    
30. '从圆心到输入的第二点画直线L2
    
31.             Set L2 = B.AddLine(C.Center, P2)
    
32. '用两直线的角度计算迭代运算的边界
    : i$ L& m& n# t) k( h: m( X& I0 g
33.             If L1.Angle - L2.Angle > 0 Then
    
34.                 If L1.Angle - L2.Angle < .Utility.AngleToReal(180, acDegrees) Then
    1 U2 d3 Z& ]) q( p0 Z
35.                     A1 = L1.Angle
    
36.                     A2 = L2.Angle
    
37.                 Else
    ! f7 E- {( j8 Q0 C- y
38.                     L1.EndPoint = P2
    
39.                     L2.EndPoint = P1
    
40.                     A1 = L1.Angle
    
41.                     A2 = L2.Angle - 2 * .Utility.AngleToReal(180, acDegrees)
    . a& ^+ i/ ]- P) h4 k
42.                 End If
    
43.             Else
    
44.                 If L2.Angle - L1.Angle < .Utility.AngleToReal(180, acDegrees) Then
    
45.                     L1.EndPoint = P2
    / a5 ~1 v# |7 C! U/ K4 F" \
46.                     L2.EndPoint = P1
    
47.                     A1 = L1.Angle
    1 x* L4 |9 ]5 y
48.                     A2 = L2.Angle
      p7 ~3 z, B. r/ {
49.                 Else
    ; A! F2 n5 X6 P
50.                     A1 = L1.Angle
    
51.                     A2 = L2.Angle - 2 * .Utility.AngleToReal(180, acDegrees)
    0 E' B2 G  z; R" R2 Z/ `+ \
52.                 End If
    ; e. f9 {. R' b1 A
53.             End If
    
54. '以圆心为起点画第直线L3
    
55.             Set L3 = B.AddLine(C.Center, C.Center)
    ' Q+ \; t8 V; @4 L$ o, A
56. '循环,迭代运算
    . r! l, e0 R' {9 n$ `, P7 Z1 j  ]
57.             Do
    ; ]: z' v2 S' c: G9 N7 X: m: N
58. '简单的插值法
    
59.                 A = (A1 + A2) / 2
    % V1 \5 o5 s1 L, b" C  m! Q
60. '直线L3和入射和反射线的端点改到圆上尝试的点
    
61.                 L3.EndPoint = .Utility.PolarPoint(C.Center, A, R)
    
62.                 L1.StartPoint = L3.EndPoint
    
63.                 L2.StartPoint = L3.EndPoint
    ) d3 Z8 @0 ^/ y2 L7 l
64. '计算入射和反射线分别与直线L3的夹角
    9 w3 i' v9 Y; ~. g
65.                 A3 = L1.Angle - L3.Angle
    
66.                 If A3 < 0 Then A3 = A3 + 2 * .Utility.AngleToReal(180, acDegrees)
    : b1 p* |2 x$ ~9 O8 P( e
67.                 A4 = L3.Angle - L2.Angle
    
68.                 If A4 < 0 Then A4 = A4 + 2 * .Utility.AngleToReal(180, acDegrees)
    
69. '如果两夹角相等或已运算到浮点数的最高精度则退出循环
    " B( G8 L$ v% a4 ~/ e3 P
70. '否则将当前尝试点作为新的边界继续循环运算
    % Y& T/ K4 n# i
71.                 If A3 = A4 Or A = A1 Or A = A2 Then
    9 |# n% C, Y1 T
72.                     Exit Do
    
73.                 ElseIf A3 > A4 Then
    
74.                     A2 = A
    
75.                 Else
    ; z9 N3 q7 ]7 B9 I
76.                     A1 = A
    
77.                 End If
    
78.             Loop
    
79.         Else
    ) G0 a) C8 D% A3 c
80.             C.Delete
    ; ]/ {' I! D+ O7 J) _
81.             L1.Delete
    
82.             Exit Sub
    
83.         End If
    2 I+ s* r4 E/ _- X6 w, o# U2 p
84.     End With
    4 ^, z9 t7 b; C8 J6 X2 ~! A4 w
85. 10:

复制代码

明天你好吗

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

( r) Y/ v# P" Y. j来晚了，接收了，版主什么多会。

明天你好吗

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

; ?4 N0 q* [7 G+ X% ^+ q$ ?版主大大，发现一个规律。只要以底边两端点为焦点作椭圆与圆相切，那么切点就是所求点。不知这个椭圆能否作出来？
0 j7 d& t' M  d: G

woaishuijia

高次方程，常规作图方法无能为力
) R! o% m8 s% k死了这条心吧

明天你好吗

woaishuijia 发表于 2016-1-17 02:34
( w; h, P' h# X# B6 V, ~7 \, r高次方程，常规作图方法无能为力
死了这条心吧

% C$ ?! q: F  z# @0 L. F! l, _还想着经常见到的现象能有常规解就好了