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

明天你好吗

4 c+ {; e8 m$ L7 Y
凸面镜反射，已知入射光线上一点与反射光线上一点，如何作入射光线与反射光线
, F" b! k) r$ r, p) |ttachimg]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
   - p$ s# @$ q# h* n' [. O5 o" O
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
   ( x# R/ {- l8 E: N5 N9 c  m. C( @
7.         With .Utility
   
8.             P1 = .GetPoint(, "指定圆外第一点")
   
9.             P2 = .GetPoint(, "指定圆外同侧第二点")
     n4 h: h0 W* x
10.             P3 = .GetPoint(, "指定圆心")
    2 o* |- p8 N  f& J3 T9 c
11.             R = .GetDistance(P3, "指定半径")
    
12.         End With
    
13. '检查输入的参数,如果有一点或两点在圆内部,则退出宏
    $ H6 {& Z9 T9 x' w, ]
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. '判断作图空间
    0 l. O- U# M- x: J+ U+ h1 t
16.         If .ActiveSpace = acModelSpace Then
    
17.             Set B = .ModelSpace
    0 K3 Q( o4 y- t8 ~: I4 H9 y
18.         Else
    : A4 s! {$ u( e" \" n
19.             Set B = .PaperSpace
    
20.         End If
    - S, a1 z" I4 E$ k# |9 Y/ ^% @9 `! R! n
21. '按输入参数画圆
    
22.         Set C = B.AddCircle(P3, R)
    6 J" a9 i2 F8 @& [8 D
23. '在输入的圆外两点间连线
    
24.         Set L1 = B.AddLine(P2, P1)
    - I) d5 h* V% s* y5 T
25. '检查连线与圆是否相交,如不相交则继续;如相交则删除圆和连线并结束宏
    2 s+ f( i( ~7 b
26.         P3 = C.IntersectWith(L1, acExtendNone)
    
27.         If UBound(P3) = -1 Then
    / {) `, ~; Q. Y
28. '将直线L1的起点改到圆心
    
29.             L1.StartPoint = C.Center
    * \8 X) j3 ^; N5 \- c
30. '从圆心到输入的第二点画直线L2
    , _4 s, |2 Y2 u) V4 J+ C
31.             Set L2 = B.AddLine(C.Center, P2)
    ; p' n+ ]2 A7 C1 X" A$ K4 n" J' i
32. '用两直线的角度计算迭代运算的边界
    
33.             If L1.Angle - L2.Angle > 0 Then
    ) ^1 V/ D/ M, f$ V
34.                 If L1.Angle - L2.Angle < .Utility.AngleToReal(180, acDegrees) Then
      j/ @! Q- G# `+ W6 @
35.                     A1 = L1.Angle
    
36.                     A2 = L2.Angle
    
37.                 Else
    / n; Y' i) Y/ C" I
38.                     L1.EndPoint = P2
    # F6 ~$ O! |2 c3 w# I: E
39.                     L2.EndPoint = P1
    
40.                     A1 = L1.Angle
    
41.                     A2 = L2.Angle - 2 * .Utility.AngleToReal(180, acDegrees)
    . y6 ]/ R# I6 u+ T' n
42.                 End If
    
43.             Else
    0 }6 z4 s1 J( y3 N( N$ }4 G
44.                 If L2.Angle - L1.Angle < .Utility.AngleToReal(180, acDegrees) Then
    
45.                     L1.EndPoint = P2
    ( F# C9 J6 B/ G# h7 I8 k
46.                     L2.EndPoint = P1
    3 d% `  W! j" p) A% R) W+ x
47.                     A1 = L1.Angle
    8 G0 K1 K- y1 k5 w6 B
48.                     A2 = L2.Angle
    7 b9 [; O1 _5 M
49.                 Else
    4 t/ i$ q) P2 Y& u- ?
50.                     A1 = L1.Angle
    
51.                     A2 = L2.Angle - 2 * .Utility.AngleToReal(180, acDegrees)
    
52.                 End If
    : V+ @/ D9 n. ^+ e9 ]* |9 x5 P8 W
53.             End If
    % ~6 _# e4 a4 d/ t' O7 F
54. '以圆心为起点画第直线L3
    $ J1 Y, `3 ?1 H
55.             Set L3 = B.AddLine(C.Center, C.Center)
    + p/ N- ?* _6 R% [) H8 P
56. '循环,迭代运算
    
57.             Do
    % _8 D$ \- w) ?% z' m
58. '简单的插值法
    
59.                 A = (A1 + A2) / 2
    
60. '直线L3和入射和反射线的端点改到圆上尝试的点
    
61.                 L3.EndPoint = .Utility.PolarPoint(C.Center, A, R)
    % i5 }! d. I( Z' J1 H
62.                 L1.StartPoint = L3.EndPoint
    
63.                 L2.StartPoint = L3.EndPoint
    
64. '计算入射和反射线分别与直线L3的夹角
    
65.                 A3 = L1.Angle - L3.Angle
    5 s  p/ ?& a% o+ Y
66.                 If A3 < 0 Then A3 = A3 + 2 * .Utility.AngleToReal(180, acDegrees)
    ( ~! F) u8 L; u
67.                 A4 = L3.Angle - L2.Angle
    5 n* u: v' ]* _0 {9 v
68.                 If A4 < 0 Then A4 = A4 + 2 * .Utility.AngleToReal(180, acDegrees)
    / i7 b. s7 A* |# h  _2 O& B/ u
69. '如果两夹角相等或已运算到浮点数的最高精度则退出循环
    
70. '否则将当前尝试点作为新的边界继续循环运算
    , f/ G: I3 b7 E& E! F* A1 z
71.                 If A3 = A4 Or A = A1 Or A = A2 Then
    
72.                     Exit Do
    
73.                 ElseIf A3 > A4 Then
    
74.                     A2 = A
    2 i5 ~8 K+ h- z5 _
75.                 Else
    ! D$ ~  T8 [( q1 Z) \) J. ~6 Q
76.                     A1 = A
    # C6 E8 \9 F, {5 j7 e
77.                 End If
    
78.             Loop
      n; P* ~. ?0 V8 O5 \" M
79.         Else
    / a2 d, R+ ^6 J  Z! U1 j2 E
80.             C.Delete
    + ~3 P) w+ m2 B8 Y- t) B; w: l; W
81.             L1.Delete
    2 Z; E9 G" V! n% n/ v
82.             Exit Sub
    . m9 R9 G) z' G9 i6 N2 C
83.         End If
    
84.     End With
    
85. 10:

复制代码

明天你好吗

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

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

明天你好吗

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

版主大大，发现一个规律。只要以底边两端点为焦点作椭圆与圆相切，那么切点就是所求点。不知这个椭圆能否作出来？
$ P3 Q3 b1 ?4 w+ C, B

woaishuijia

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

明天你好吗

woaishuijia 发表于 2016-1-17 02:34
" i$ {4 _+ O2 i( k: f: W7 B高次方程，常规作图方法无能为力
死了这条心吧

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