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

明天你好吗

6 r0 o# U2 W* R) V" v1 \  r

+ j) }9 A6 @# Q8 R  t/ k  Q凸面镜反射，已知入射光线上一点与反射光线上一点，如何作入射光线与反射光线
ttachimg]2272051[/attachimg]

woaishuijia

' x5 X' u+ D, H

1.     Dim P1 As Variant, P2 As Variant, P3 As Variant, R As Double
   & t6 C# f) s7 }
2.     Dim B As AcadBlock, C As AcadCircle, L1 As AcadLine, L2 As AcadLine, L3 As AcadLine
   , g2 m( h# h: y0 I) T4 ]
3.     Dim A As Double, A1 As Double, A2 As Double, A3 As Double, A4 As Double
   
4.     With ThisDrawing
   
5. '操作者屏幕输入参数
   
6.         On Error GoTo 10
   
7.         With .Utility
   
8.             P1 = .GetPoint(, "指定圆外第一点")
   
9.             P2 = .GetPoint(, "指定圆外同侧第二点")
   9 X" e: b) J* k3 c, t
10.             P3 = .GetPoint(, "指定圆心")
    " g! ^8 J; B4 j- E5 r  Y6 u
11.             R = .GetDistance(P3, "指定半径")
    ) `* I: K; j8 e# o
12.         End With
    6 R0 g9 t1 K$ U! W! n
13. '检查输入的参数,如果有一点或两点在圆内部,则退出宏
    ; f1 u4 v+ Z2 @
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
    : j" x8 V7 H/ V9 @+ {
15. '判断作图空间
    
16.         If .ActiveSpace = acModelSpace Then
    8 T' l- Z. f% l' p1 s$ H& \: X
17.             Set B = .ModelSpace
    . p: [3 w- n  e8 |2 A
18.         Else
    
19.             Set B = .PaperSpace
    
20.         End If
    8 g$ M. m& x$ R
21. '按输入参数画圆
    
22.         Set C = B.AddCircle(P3, R)
    , n3 B3 ^0 s4 y1 k! p0 g9 M! f. ]
23. '在输入的圆外两点间连线
    
24.         Set L1 = B.AddLine(P2, P1)
    1 F9 f' {0 H9 j0 b. C1 v) B$ [
25. '检查连线与圆是否相交,如不相交则继续;如相交则删除圆和连线并结束宏
    0 q( R+ ~6 o- L9 H, {. e
26.         P3 = C.IntersectWith(L1, acExtendNone)
    
27.         If UBound(P3) = -1 Then
    ' }; d; ]( y3 n1 ^4 n4 O$ v
28. '将直线L1的起点改到圆心
    1 z6 g8 O  w# P& T
29.             L1.StartPoint = C.Center
    ) l, [* p9 T! t/ l: _
30. '从圆心到输入的第二点画直线L2
    4 |+ g/ ?; B* [0 I
31.             Set L2 = B.AddLine(C.Center, P2)
    
32. '用两直线的角度计算迭代运算的边界
    
33.             If L1.Angle - L2.Angle > 0 Then
    
34.                 If L1.Angle - L2.Angle < .Utility.AngleToReal(180, acDegrees) Then
    : Y% u8 G) K% g- `2 `% z* i
35.                     A1 = L1.Angle
    
36.                     A2 = L2.Angle
    ( M1 Y7 L5 R; O3 I( k2 T6 {7 c  c
37.                 Else
    " w6 k( h! F7 {0 V5 C
38.                     L1.EndPoint = P2
    6 f. N& q. s+ F! A0 M% g
39.                     L2.EndPoint = P1
    
40.                     A1 = L1.Angle
    : J: [* w0 e2 G4 d/ @* a3 f! K# G
41.                     A2 = L2.Angle - 2 * .Utility.AngleToReal(180, acDegrees)
    
42.                 End If
    
43.             Else
    : s  U: F; n% k
44.                 If L2.Angle - L1.Angle < .Utility.AngleToReal(180, acDegrees) Then
    
45.                     L1.EndPoint = P2
    ! Y: @& Y! b0 ?4 `0 a8 g" p8 ^
46.                     L2.EndPoint = P1
    
47.                     A1 = L1.Angle
    6 t) S& L1 m: Q7 |
48.                     A2 = L2.Angle
    7 e- f, N6 O% N$ k: [  O9 Y% i6 s
49.                 Else
    ! {7 n- m) p9 g2 j7 N; j+ L
50.                     A1 = L1.Angle
    * u7 f5 j  K# W$ {! P& g
51.                     A2 = L2.Angle - 2 * .Utility.AngleToReal(180, acDegrees)
    
52.                 End If
    
53.             End If
    
54. '以圆心为起点画第直线L3
    7 E0 b: O3 v0 C
55.             Set L3 = B.AddLine(C.Center, C.Center)
    
56. '循环,迭代运算
    
57.             Do
    8 L& d9 i/ e! o7 ]' m3 D+ ^
58. '简单的插值法
    
59.                 A = (A1 + A2) / 2
    . ]- D4 a5 o& J: F( x. t
60. '直线L3和入射和反射线的端点改到圆上尝试的点
    
61.                 L3.EndPoint = .Utility.PolarPoint(C.Center, A, R)
    ( s  x6 x2 I0 ]% c" |
62.                 L1.StartPoint = L3.EndPoint
    
63.                 L2.StartPoint = L3.EndPoint
    & c7 ]# L  }) ?+ V0 N4 W) y1 n  J
64. '计算入射和反射线分别与直线L3的夹角
    0 B3 k) ^8 [9 \7 ?- \+ H2 P9 x2 F' z
65.                 A3 = L1.Angle - L3.Angle
    6 b, b; w6 S& _5 k6 x0 |7 I
66.                 If A3 < 0 Then A3 = A3 + 2 * .Utility.AngleToReal(180, acDegrees)
    
67.                 A4 = L3.Angle - L2.Angle
    7 l1 L; J/ O' z( o0 t  L5 P
68.                 If A4 < 0 Then A4 = A4 + 2 * .Utility.AngleToReal(180, acDegrees)
    * R) X: S, X. z1 \" A8 |0 D
69. '如果两夹角相等或已运算到浮点数的最高精度则退出循环
    
70. '否则将当前尝试点作为新的边界继续循环运算
    
71.                 If A3 = A4 Or A = A1 Or A = A2 Then
    
72.                     Exit Do
      ~5 Q$ _. a: r
73.                 ElseIf A3 > A4 Then
    
74.                     A2 = A
    - W8 C0 ?! c* {5 N  a: S
75.                 Else
    / n  ~* X$ b" c
76.                     A1 = A
      M% Y7 ?  ]- B
77.                 End If
    5 B% z7 }/ n& M- m1 W( |9 T/ |+ D
78.             Loop
    
79.         Else
    
80.             C.Delete
    
81.             L1.Delete
    - ?$ K& Q9 ?" a4 ^4 M
82.             Exit Sub
    
83.         End If
    
84.     End With
    ! \3 v8 z* p; f. i# Z2 l+ V8 g
85. 10:

复制代码

明天你好吗

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

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

明天你好吗

9 ^. P8 v. z- J, O" J) a) a

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

版主大大，发现一个规律。只要以底边两端点为焦点作椭圆与圆相切，那么切点就是所求点。不知这个椭圆能否作出来？

woaishuijia

高次方程，常规作图方法无能为力
4 ~- ]% V% P- @! `+ h  ~死了这条心吧

明天你好吗

woaishuijia 发表于 2016-1-17 02:34
" Z  k- L) `9 j* Y高次方程，常规作图方法无能为力
死了这条心吧

1 _+ j4 G. P  t还想着经常见到的现象能有常规解就好了