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

明天你好吗

: t" [2 f3 b1 y: U/ w' _4 I+ l
  s- i: ]$ T- x1 Z$ _
( a2 w% g- s. @" V凸面镜反射，已知入射光线上一点与反射光线上一点，如何作入射光线与反射光线
ttachimg]2272051[/attachimg]

woaishuijia

; b' f3 u" U4 \: [

1.     Dim P1 As Variant, P2 As Variant, P3 As Variant, R As Double
   9 t: T9 B) v1 R1 |( I' T9 i
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
   % V& d5 P" u0 W2 C7 d
4.     With ThisDrawing
   * i! V: h3 y8 z7 C/ I2 S! d/ d
5. '操作者屏幕输入参数
   
6.         On Error GoTo 10
   7 n9 P! q  \3 r* q
7.         With .Utility
   & l7 i1 [5 W) m& B& J) G" T9 }
8.             P1 = .GetPoint(, "指定圆外第一点")
   
9.             P2 = .GetPoint(, "指定圆外同侧第二点")
   9 I+ S. ^; S# x2 Y, T. F! f! d8 d. k
10.             P3 = .GetPoint(, "指定圆心")
    
11.             R = .GetDistance(P3, "指定半径")
    
12.         End With
    
13. '检查输入的参数,如果有一点或两点在圆内部,则退出宏
      z0 l. a; c" e$ w  t
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. '判断作图空间
    
16.         If .ActiveSpace = acModelSpace Then
    + L0 u4 \% O& q
17.             Set B = .ModelSpace
    
18.         Else
    4 `7 e) b$ ]9 c; D0 A" ^& e
19.             Set B = .PaperSpace
    
20.         End If
    5 t; ^5 o6 i. v2 J7 z% a
21. '按输入参数画圆
    
22.         Set C = B.AddCircle(P3, R)
    ; s; _8 O6 T. s: c( u
23. '在输入的圆外两点间连线
    
24.         Set L1 = B.AddLine(P2, P1)
    
25. '检查连线与圆是否相交,如不相交则继续;如相交则删除圆和连线并结束宏
    1 j; p4 x5 {- C# A
26.         P3 = C.IntersectWith(L1, acExtendNone)
    / V1 U6 T/ A) j+ T; T1 G
27.         If UBound(P3) = -1 Then
    
28. '将直线L1的起点改到圆心
    ) b: v1 e0 v: X, S  |3 w
29.             L1.StartPoint = C.Center
    8 k. j2 B, v) @2 b- P7 ?5 p# w
30. '从圆心到输入的第二点画直线L2
    
31.             Set L2 = B.AddLine(C.Center, P2)
    % \$ G9 |2 {0 Z$ j: ]' g- o
32. '用两直线的角度计算迭代运算的边界
    3 M  {# G8 |: @, i/ ~
33.             If L1.Angle - L2.Angle > 0 Then
    
34.                 If L1.Angle - L2.Angle < .Utility.AngleToReal(180, acDegrees) Then
    
35.                     A1 = L1.Angle
    4 }( D6 v% p! C* x% y6 H
36.                     A2 = L2.Angle
    ! ~7 D. c- V: h! t, O
37.                 Else
    7 N* @, G* M. j" V( l
38.                     L1.EndPoint = P2
    ; T2 S9 @" H1 y( h
39.                     L2.EndPoint = P1
    + j8 m# H: X7 C) s" F% M. b
40.                     A1 = L1.Angle
    
41.                     A2 = L2.Angle - 2 * .Utility.AngleToReal(180, acDegrees)
    
42.                 End If
    9 A: z7 z: q9 K2 v0 z4 Z' @: L1 `
43.             Else
    
44.                 If L2.Angle - L1.Angle < .Utility.AngleToReal(180, acDegrees) Then
    
45.                     L1.EndPoint = P2
    
46.                     L2.EndPoint = P1
    
47.                     A1 = L1.Angle
    
48.                     A2 = L2.Angle
    ' l3 o+ X. K9 o. P: ~
49.                 Else
    
50.                     A1 = L1.Angle
    
51.                     A2 = L2.Angle - 2 * .Utility.AngleToReal(180, acDegrees)
    
52.                 End If
    . s$ }# g& G/ _
53.             End If
    * r& L& M7 J1 T
54. '以圆心为起点画第直线L3
    # \5 V4 d0 I7 a$ K# N% a! j1 H
55.             Set L3 = B.AddLine(C.Center, C.Center)
    8 Q! K& j' ?( f
56. '循环,迭代运算
    # \. ~5 f3 v- L
57.             Do
    ! T! A' L0 i7 h* ?7 z
58. '简单的插值法
    % r5 T7 a% W( m( d, B" N- M/ k
59.                 A = (A1 + A2) / 2
    
60. '直线L3和入射和反射线的端点改到圆上尝试的点
    ' W! K7 A7 u0 g! y, `% F: S7 Z
61.                 L3.EndPoint = .Utility.PolarPoint(C.Center, A, R)
    " P# X7 a( D9 H4 h. v5 D
62.                 L1.StartPoint = L3.EndPoint
    2 n" Z; G( B* k8 }& M  d- x
63.                 L2.StartPoint = L3.EndPoint
    0 L; A. `- K# u& u- E' q3 x1 E
64. '计算入射和反射线分别与直线L3的夹角
    
65.                 A3 = L1.Angle - L3.Angle
    ) y: n  m7 n/ e# g2 {6 I; d/ r
66.                 If A3 < 0 Then A3 = A3 + 2 * .Utility.AngleToReal(180, acDegrees)
    $ h4 h; E1 Q0 i
67.                 A4 = L3.Angle - L2.Angle
    , s3 W% N9 o3 x/ k$ w
68.                 If A4 < 0 Then A4 = A4 + 2 * .Utility.AngleToReal(180, acDegrees)
    
69. '如果两夹角相等或已运算到浮点数的最高精度则退出循环
    ! i! ?0 k2 }2 Y
70. '否则将当前尝试点作为新的边界继续循环运算
    
71.                 If A3 = A4 Or A = A1 Or A = A2 Then
    
72.                     Exit Do
    
73.                 ElseIf A3 > A4 Then
    
74.                     A2 = A
    
75.                 Else
    * R  L# h0 b1 G3 \" `' i) S6 q% ?. Y
76.                     A1 = A
    : ^, K' g+ n1 p5 G, n2 n- G4 J7 x
77.                 End If
    7 c1 M0 [. C! E4 f; M, s
78.             Loop
    * g) j, J- `0 S
79.         Else
    
80.             C.Delete
    % _4 ^8 `. R& h" P$ Z8 D$ a
81.             L1.Delete
    0 \3 M; O2 j7 `+ p
82.             Exit Sub
    ! v7 K, G+ t" E3 Q0 R
83.         End If
    
84.     End With
    
85. 10:

复制代码

明天你好吗

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

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

明天你好吗

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

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

woaishuijia

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

明天你好吗

woaishuijia 发表于 2016-1-17 02:34
0 j) a. h% u) \' V高次方程，常规作图方法无能为力
1 J7 ~& K0 X! ]* _% T- p/ x死了这条心吧

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