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

明天你好吗

! ~6 B5 S1 `' p6 r% |4 ?# m凸面镜反射，已知入射光线上一点与反射光线上一点，如何作入射光线与反射光线
. M0 {7 r7 t: o! u  t  H/ httachimg]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
   
3.     Dim A As Double, A1 As Double, A2 As Double, A3 As Double, A4 As Double
   5 @! Y+ u% I8 v! t" m+ F0 ]; S7 u% m
4.     With ThisDrawing
   
5. '操作者屏幕输入参数
   
6.         On Error GoTo 10
   5 R  M/ {5 u0 R1 E* l% ?
7.         With .Utility
   : e/ t+ j0 Z$ @. @
8.             P1 = .GetPoint(, "指定圆外第一点")
   
9.             P2 = .GetPoint(, "指定圆外同侧第二点")
   
10.             P3 = .GetPoint(, "指定圆心")
    
11.             R = .GetDistance(P3, "指定半径")
    
12.         End With
    3 R; h4 U5 Q, r6 V( h8 Y& Z! }
13. '检查输入的参数,如果有一点或两点在圆内部,则退出宏
    
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
    ; H+ b8 r2 p3 Q0 O# j' ]
15. '判断作图空间
    ' c0 A2 n+ [7 K0 y% y3 U" T% ^7 x
16.         If .ActiveSpace = acModelSpace Then
    7 f  j/ x) F+ }* i/ \% v
17.             Set B = .ModelSpace
    : n- G; ?* o6 x& F
18.         Else
      a( K7 D* ~9 H" w6 C
19.             Set B = .PaperSpace
    7 k6 p3 G& v% U$ l) h& W
20.         End If
    
21. '按输入参数画圆
    
22.         Set C = B.AddCircle(P3, R)
    
23. '在输入的圆外两点间连线
    
24.         Set L1 = B.AddLine(P2, P1)
    % Y- y* k1 d5 ^
25. '检查连线与圆是否相交,如不相交则继续;如相交则删除圆和连线并结束宏
    6 y' ^  W! e# t# n) B, {: ?# g
26.         P3 = C.IntersectWith(L1, acExtendNone)
    7 y3 b& n, \. ^  u# j$ `( K4 U
27.         If UBound(P3) = -1 Then
    
28. '将直线L1的起点改到圆心
    
29.             L1.StartPoint = C.Center
    
30. '从圆心到输入的第二点画直线L2
    
31.             Set L2 = B.AddLine(C.Center, P2)
    
32. '用两直线的角度计算迭代运算的边界
    
33.             If L1.Angle - L2.Angle > 0 Then
    $ Q4 K' S0 e8 l7 t
34.                 If L1.Angle - L2.Angle < .Utility.AngleToReal(180, acDegrees) Then
    , G' [! F; u. C
35.                     A1 = L1.Angle
    
36.                     A2 = L2.Angle
    
37.                 Else
    0 r$ f( t* \  {# }. N0 Q% ]0 ]( y
38.                     L1.EndPoint = P2
    & \" P! c1 l, R! f5 u% Q/ y* k
39.                     L2.EndPoint = P1
    0 ^" }; B0 a" ~8 z. i4 L
40.                     A1 = L1.Angle
    & j# H1 r6 [: M8 V7 m; O
41.                     A2 = L2.Angle - 2 * .Utility.AngleToReal(180, acDegrees)
    
42.                 End If
    * e, p+ u3 H- A, ^+ ?2 `  q$ i! y
43.             Else
    8 L* u$ l2 x4 y0 L1 @
44.                 If L2.Angle - L1.Angle < .Utility.AngleToReal(180, acDegrees) Then
    
45.                     L1.EndPoint = P2
    - d, v. J# j7 \0 f, p' u
46.                     L2.EndPoint = P1
    8 i: ]" q1 n3 a9 l* x
47.                     A1 = L1.Angle
    / }9 D1 D, G! l+ D
48.                     A2 = L2.Angle
    " W: M6 O; R# i# g& S; r$ D
49.                 Else
    
50.                     A1 = L1.Angle
    
51.                     A2 = L2.Angle - 2 * .Utility.AngleToReal(180, acDegrees)
    
52.                 End If
    - B" o* c. o& }8 l
53.             End If
    
54. '以圆心为起点画第直线L3
      w1 ^; U$ A7 W# H% c
55.             Set L3 = B.AddLine(C.Center, C.Center)
    6 ^, q6 k: r3 l+ I( u1 y
56. '循环,迭代运算
    " L& L7 e! W# V9 @8 r! j
57.             Do
    
58. '简单的插值法
    % \/ |; \/ ]1 n) y7 U0 W' r4 K
59.                 A = (A1 + A2) / 2
    # K( c& |1 n4 Q% b3 ]9 ]
60. '直线L3和入射和反射线的端点改到圆上尝试的点
    * j% |) H8 f2 u& o# e$ i
61.                 L3.EndPoint = .Utility.PolarPoint(C.Center, A, R)
    
62.                 L1.StartPoint = L3.EndPoint
    
63.                 L2.StartPoint = L3.EndPoint
    6 |9 f0 D: @5 I
64. '计算入射和反射线分别与直线L3的夹角
    
65.                 A3 = L1.Angle - L3.Angle
    # H9 F$ s4 s3 x0 R) z8 ?8 O
66.                 If A3 < 0 Then A3 = A3 + 2 * .Utility.AngleToReal(180, acDegrees)
    6 L2 `! Q& A/ L3 [3 J5 o
67.                 A4 = L3.Angle - L2.Angle
    
68.                 If A4 < 0 Then A4 = A4 + 2 * .Utility.AngleToReal(180, acDegrees)
    8 Y4 E& G  t/ D' b7 U
69. '如果两夹角相等或已运算到浮点数的最高精度则退出循环
    
70. '否则将当前尝试点作为新的边界继续循环运算
    
71.                 If A3 = A4 Or A = A1 Or A = A2 Then
    2 W  d2 V8 w3 h
72.                     Exit Do
    
73.                 ElseIf A3 > A4 Then
    
74.                     A2 = A
    
75.                 Else
    
76.                     A1 = A
    
77.                 End If
    . ?  t& _+ d. r% L& t5 k
78.             Loop
    7 P6 {$ t( A; B! _8 K- g
79.         Else
    ' d: O- N) J/ A7 r" `$ I7 ^* j" p
80.             C.Delete
    % U# A9 L( [) Q, f# m% ^- M, Q
81.             L1.Delete
    
82.             Exit Sub
    
83.         End If
    
84.     End With
    2 f! J8 b, a' R; u! y% I
85. 10:

复制代码

明天你好吗

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

2 T7 R9 L( `$ n0 ~来晚了，接收了，版主什么多会。

明天你好吗

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

1 l- z. P( l: a0 O8 M" [9 {- ^" |5 f( \版主大大，发现一个规律。只要以底边两端点为焦点作椭圆与圆相切，那么切点就是所求点。不知这个椭圆能否作出来？

woaishuijia

高次方程，常规作图方法无能为力
; J. r1 Y. _# j  h+ x死了这条心吧

明天你好吗

woaishuijia 发表于 2016-1-17 02:34
6 R9 \; o) i0 u# @# w- y7 \7 v高次方程，常规作图方法无能为力
/ n- }! j2 \1 o& t死了这条心吧

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