偶尔兴致来了，练习一些图表，记录一下

众妙之门1

很实用，感谢楼主分享

micch

另一帖子的参考，用贝塞尔公式计算曲线做了一下，搞的啰嗦点，把每一个部分，单独做辅助数据

贝塞尔面积图.zip (49.93 KB, 下载次数: 12)

2024-6-11 21:44 上传

点击文件名下载附件

eric_889

micch 发表于 2024-6-11 21:46
另一帖子的参考，用贝塞尔公式计算曲线做了一下，搞的啰嗦点，把每一个部分，单独做辅助数据

感谢micch,终于可以学到计算方法了。

wb_1027

假设有个小球，在原点（0,0）出发，出发角度15度，经过15次反弹的轨迹图。

盖一层楼！

wb_1027

micch

wb_1027 发表于 2024-6-29 20:03
假设有个小球，在原点（0,0）出发，出发角度15度，经过15次反弹的轨迹图。

盖一层楼！

费劲算了半天没算对，（0,0）出发，右上15度，第三次在左侧边反弹，反弹后的方向是指向右下角。

不知道哪里算错了，检查起来怪麻烦。

话说，会不会任意角度出发，终究会发反弹到4个顶角位置。如果到顶角，反弹方向应该是怎么算，会不会就陷入一个循环路线来转圈反弹了？

木槿花西月锦绣

micch 发表于 2024-6-30 17:29
费劲算了半天没算对，（0,0）出发，右上15度，第三次在左侧边反弹，反弹后的方向是指向右下角。

不知 ...

1. Dim x!(1 To 3), y!(1 To 3), deg, rad!, tg!, res(), rig As Boolean, _
   
2. down As Boolean, tp, bt, lf, rg, fx, fy
   
3. Const maxx = 20, maxy = 10
   
4. 
   
5. Sub Main()
   
6. ReDim tp(1 To 4), bt(1 To 4), lf(1 To 4), rg(1 To 4), res(1 To 2)
   
7. Dim i%, keep(1 To 2), s As Series, co As Shape, ns%
   
8. tp(1) = 0: tp(2) = maxy: tp(3) = maxx: tp(4) = maxy     ' 上边线
   
9. bt(1) = 0: bt(2) = 0: bt(3) = maxx: bt(4) = 0           ' 下边线
   
10. lf(1) = 0: lf(2) = 0: lf(3) = 0: lf(4) = maxy           ' 左边线
    
11. rg(1) = maxx: rg(2) = 0: rg(3) = maxx: rg(4) = maxy     ' 右边线
    
12. rig = True
    
13. ns = 23
    
14. ReDim fx(1 To ns), fy(1 To ns)
    
15. down = False
    
16. x(1) = 1: y(1) = 3             ' 起始点
    
17. res(1) = x(1): res(2) = y(1)
    
18. x(2) = x(1) + maxx
    
19. y(2) = y(1): x(3) = x(2)
    
20. deg = 80                        ' 度数
    
21. rad = deg * 3.14159 / 180       ' 弧度
    
22. tg = Tan(rad)
    
23. y(3) = tg * (x(2) - x(1)) + y(2)
    
24. fx(1) = x(1): fy(1) = y(1)
    
25. For i = 2 To ns                 ' 步数
    
26.    If rig And down Then
    
27.      keep(1) = res(1): keep(2) = res(2)
    
28.      Walk rg, False, False
    
29.      If res(1) = 0 And res(2) = 0 Then
    
30.        res(1) = keep(1): res(2) = keep(2)
    
31.        Walk bt, False, False
    
32.        down = Not down
    
33.      Else
    
34.        rig = Not rig
    
35.      End If
    
36.    ElseIf rig And Not down Then            ' 向右上
    
37.      keep(1) = res(1): keep(2) = res(2)
    
38.      Walk tp, False, True
    
39.      If res(1) = 0 And res(2) = 0 Then
    
40.        res(1) = keep(1): res(2) = keep(2)
    
41.        Walk rg, False, True
    
42.        rig = Not rig
    
43.      Else
    
44.        down = Not down
    
45.      End If
    
46.    ElseIf Not rig And down Then            ' 左下
    
47.      keep(1) = res(1): keep(2) = res(2)
    
48.      Walk bt, True, False
    
49.      If res(1) = 0 And res(2) = 0 Then   ' 没有有效的交叉
    
50.        res(1) = keep(1): res(2) = keep(2)
    
51.        Walk lf, True, False
    
52.        rig = Not rig
    
53.      Else
    
54.        down = Not down
    
55.      End If
    
56.    ElseIf Not rig And Not down Then        ' 左上
    
57.      keep(1) = res(1): keep(2) = res(2)
    
58.      Walk lf, True, True
    
59.      If res(1) = 0 And res(2) = 0 Then
    
60.        res(1) = keep(1): res(2) = keep(2)
    
61.        Walk tp, True, True
    
62.        down = Not down
    
63.      Else
    
64.        rig = Not rig
    
65.      End If
    
66.    End If
    
67.    fx(i) = res(1): fy(i) = res(2)
    
68. Next
    
69. Set co = ActiveSheet.Shapes.AddChart2(240, xlXYScatterLines)
    
70. Set s = co.Chart.SeriesCollection.NewSeries
    
71. s.Values = fy
    
72. s.XValues = fx
    
73. With co.Chart
    
74.    .ChartTitle.Text = "Start is " & fx(1) & "," & fy(1) & " - " & _
    
75.    WorksheetFunction.Unichar(952) & "=" & deg
    
76.    If .SeriesCollection.Count > 1 Then
    
77.      .SeriesCollection(1).Delete
    
78.      .Axes(xlValue).MaximumScale = maxy
    
79.      .Axes(xlCategory).MaximumScale = maxx
    
80.      .Axes(xlCategory).MinimumScale = 0
    
81.      .Axes(xlValue).MinimumScale = 0
    
82.     End If
    
83. End With
    
84. End Sub
    
85. 
    
86. Sub Walk(con, left As Boolean, up As Boolean)
    
87. Dim hor
    
88. If left Then hor = -maxx
    
89. If Not left Then hor = maxx
    
90. x(1) = res(1): y(1) = res(2)
    
91. x(2) = x(1) + hor
    
92. y(2) = y(1): x(3) = x(2)
    
93. y(3) = tg * (x(2) - x(1)) + y(2)                    ' 是三角形
    
94. If Not up And Not left Then y(3) = 2 * y(1) - y(3)  ' 正确象限
    
95. If up And left Then y(3) = 2 * y(1) - y(3)
    
96. res = inter(x(1), y(1), x(3), y(3), con)
    
97. End Sub
    
98. 
    
99. Function inter(x1!, y1!, x2!, y2!, con) ' 两线之间的交叉
    
100. Dim tp, den, ua!, ub!, x3!, y3!, x4!, y4!
     
101. x3 = con(1): y3 = con(2): x4 = con(3): y4 = con(4)
     
102. ReDim tp(1 To 2)
     
103. If ((x1 = x2 And y1 = y2) Or (x3 = x4 And y3 = y4)) Then
     
104.    tp(1) = 0
     
105.    tp(2) = 0
     
106.    inter = tp
     
107.    Exit Function
     
108. End If
     
109. den = ((y4 - y3) * (x2 - x1) - (x4 - x3) * (y2 - y1))
     
110. If den = 0 Then
     
111.    tp(1) = 0
     
112.    tp(2) = 0
     
113.    inter = tp
     
114.    Exit Function
     
115. End If
     
116. ua = ((x4 - x3) * (y1 - y3) - (y4 - y3) * (x1 - x3)) / den
     
117. ub = ((x2 - x1) * (y1 - y3) - (y2 - y1) * (x1 - x3)) / den
     
118. If ua < 0 Or ua > 1 Or ub < 0 Or ub > 1 Then
     
119.    tp(1) = 0
     
120.    tp(2) = 0
     
121.    inter = tp
     
122.    Exit Function
     
123. End If
     
124. tp(1) = x1 + ua * (x2 - x1)
     
125. tp(2) = y1 + ua * (y2 - y1)
     
126. inter = tp
     
127. End Function
     
128. 
     

复制代码

木槿花西月锦绣

micch 发表于 2024-6-30 17:29
费劲算了半天没算对，（0,0）出发，右上15度，第三次在左侧边反弹，反弹后的方向是指向右下角。

不知 ...

https://mp.weixin.qq.com/s/E-eOoCGHn8rK1uvBs-P8hg

反正我是没看明白

micch

micch

木槿花西月锦绣 发表于 2024-6-30 18:17
https://mp.weixin.qq.com/s/E-eOoCGHn8rK1uvBs-P8hg

反正我是没看明白

代码没看明白，不过，我计算逻辑中有个正负号写反了，改了后能对上了