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

明天你好吗

* R, Z: S4 R+ P/ Y7 q凸面镜反射，已知入射光线上一点与反射光线上一点，如何作入射光线与反射光线
ttachimg]2272051[/attachimg]

woaishuijia

: g/ y5 o6 q; ^6 {0 P

1.     Dim P1 As Variant, P2 As Variant, P3 As Variant, R As Double
   & e# K. \9 }# h: b# T0 e6 c# \5 G
2.     Dim B As AcadBlock, C As AcadCircle, L1 As AcadLine, L2 As AcadLine, L3 As AcadLine
   ; \/ C7 B6 y* w
3.     Dim A As Double, A1 As Double, A2 As Double, A3 As Double, A4 As Double
   3 a. V6 N; a$ _
4.     With ThisDrawing
   
5. '操作者屏幕输入参数
   
6.         On Error GoTo 10
   
7.         With .Utility
   
8.             P1 = .GetPoint(, "指定圆外第一点")
   ; o+ D, Z% f. |2 i$ p' J* N
9.             P2 = .GetPoint(, "指定圆外同侧第二点")
   
10.             P3 = .GetPoint(, "指定圆心")
    - ]4 q! I! E7 ]5 |- v
11.             R = .GetDistance(P3, "指定半径")
    
12.         End With
    
13. '检查输入的参数,如果有一点或两点在圆内部,则退出宏
    1 n) n' C! v2 R$ I" }& N
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
    5 m! i* d2 V# |4 G; T3 c) U
15. '判断作图空间
    
16.         If .ActiveSpace = acModelSpace Then
    , c" w' }# Y( e, j% L
17.             Set B = .ModelSpace
    # S8 [' V6 y* p
18.         Else
    , H2 e) |% ^* S2 i
19.             Set B = .PaperSpace
    
20.         End If
    
21. '按输入参数画圆
    
22.         Set C = B.AddCircle(P3, R)
    
23. '在输入的圆外两点间连线
    
24.         Set L1 = B.AddLine(P2, P1)
    
25. '检查连线与圆是否相交,如不相交则继续;如相交则删除圆和连线并结束宏
    * {9 [7 T4 n+ K) U; `: X
26.         P3 = C.IntersectWith(L1, acExtendNone)
    
27.         If UBound(P3) = -1 Then
    , [8 z  h; H; e9 U3 @  v$ L
28. '将直线L1的起点改到圆心
    4 }+ l/ m# s/ |5 E
29.             L1.StartPoint = C.Center
    8 L/ |$ J. v# W) S
30. '从圆心到输入的第二点画直线L2
    # y' U5 C) `/ X3 {4 X6 l% r- @/ o; T
31.             Set L2 = B.AddLine(C.Center, P2)
    * L" \& D2 H6 I$ S4 \
32. '用两直线的角度计算迭代运算的边界
    
33.             If L1.Angle - L2.Angle > 0 Then
    
34.                 If L1.Angle - L2.Angle < .Utility.AngleToReal(180, acDegrees) Then
    
35.                     A1 = L1.Angle
    ( |/ {. ~! |+ y1 [6 l. l
36.                     A2 = L2.Angle
    . a3 H6 N( S! y  b. \
37.                 Else
    
38.                     L1.EndPoint = P2
    
39.                     L2.EndPoint = P1
    
40.                     A1 = L1.Angle
      C$ P+ m! Q- j6 e1 v, ~
41.                     A2 = L2.Angle - 2 * .Utility.AngleToReal(180, acDegrees)
    7 D3 f' n( _! l
42.                 End If
    
43.             Else
    4 ~8 S, P5 W' Q5 t, {
44.                 If L2.Angle - L1.Angle < .Utility.AngleToReal(180, acDegrees) Then
    ' z6 |! `8 d) g" u1 P, o0 E
45.                     L1.EndPoint = P2
    - X, H! @% M4 y% T
46.                     L2.EndPoint = P1
    
47.                     A1 = L1.Angle
    
48.                     A2 = L2.Angle
    6 D; h/ S0 I1 O; n# I
49.                 Else
    % i* Z- G5 H. E  n3 a, ~
50.                     A1 = L1.Angle
    ) O( j( W9 N) z, z7 O( V
51.                     A2 = L2.Angle - 2 * .Utility.AngleToReal(180, acDegrees)
    
52.                 End If
    4 z  L# {# f* W: S' C) C4 j
53.             End If
    
54. '以圆心为起点画第直线L3
    ' b  U5 o- `% b, Z/ A
55.             Set L3 = B.AddLine(C.Center, C.Center)
    2 ~% w& r" n6 j4 s
56. '循环,迭代运算
    7 j  ~' j4 r( j4 i8 v' a2 F2 g
57.             Do
    
58. '简单的插值法
    : {3 C6 u# O& [; `+ ]1 Q: X* S' g7 H
59.                 A = (A1 + A2) / 2
    4 H2 Y* {9 x2 B+ {! C
60. '直线L3和入射和反射线的端点改到圆上尝试的点
    " V7 B; U! g' J9 {, _1 {1 l
61.                 L3.EndPoint = .Utility.PolarPoint(C.Center, A, R)
    / t* S! _5 h% B7 i+ I
62.                 L1.StartPoint = L3.EndPoint
    . {* u+ L6 d! |5 i8 Y: h8 \
63.                 L2.StartPoint = L3.EndPoint
    
64. '计算入射和反射线分别与直线L3的夹角
    
65.                 A3 = L1.Angle - L3.Angle
    
66.                 If A3 < 0 Then A3 = A3 + 2 * .Utility.AngleToReal(180, acDegrees)
    7 O2 I" \5 t2 e9 N7 ]% w9 ]
67.                 A4 = L3.Angle - L2.Angle
    7 @0 X: w% V% N3 i* ?0 v8 p
68.                 If A4 < 0 Then A4 = A4 + 2 * .Utility.AngleToReal(180, acDegrees)
    7 o# p9 l; A% s" {5 \' h
69. '如果两夹角相等或已运算到浮点数的最高精度则退出循环
    
70. '否则将当前尝试点作为新的边界继续循环运算
    
71.                 If A3 = A4 Or A = A1 Or A = A2 Then
    1 K2 d4 M" Z3 W# |, X: R
72.                     Exit Do
    ' Q- Q( N8 [7 i2 t( P) x0 O
73.                 ElseIf A3 > A4 Then
    ' f& N0 `% l: u/ ?
74.                     A2 = A
    
75.                 Else
    
76.                     A1 = A
    7 _" v1 ?" t0 j5 M$ o3 o% U
77.                 End If
    
78.             Loop
    ' G8 g; z/ [9 U! T4 u2 A0 X: c
79.         Else
    6 C# a+ O* k8 r% Q$ S- @
80.             C.Delete
    " b, I7 q# @; a. ^% M# H
81.             L1.Delete
    
82.             Exit Sub
    
83.         End If
    
84.     End With
    % {2 R# i, Y2 A  n6 E9 ^3 {
85. 10:

复制代码

明天你好吗

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

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

明天你好吗

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

版主大大，发现一个规律。只要以底边两端点为焦点作椭圆与圆相切，那么切点就是所求点。不知这个椭圆能否作出来？
" ^+ `  }* c, L7 O6 X

woaishuijia

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

明天你好吗

woaishuijia 发表于 2016-1-17 02:34
& S( h% D6 e# U高次方程，常规作图方法无能为力
/ \. i  c8 ~/ z5 L死了这条心吧

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