円の内側で円を転がす ~n個の円に対応(第一部.完)~
先日から、Excelでスピログラフを作成している。
infoment.hatenablog.com
今日も、昨日の続きから。
昨日は、式の一般化には成功したものの、散布図の種類設定がまずかった。
例)軌跡を描かず、点が散布されただけのパターン。
仕方ない。都度設定しなおすよう、マクロに盛り込むとしよう。
ついでにやったのが、こちら。
- 円の径や個数などを引数にした。
- 変数の略称を改めた(例.rn を RoundNumber とした)。
- 背景を黒にして、雰囲気を出してみた(好みの問題)。
Sub スピログラフ_1(r1 As Long, r2 As Long, r3 As Long, _ Optional division_count As Long = 36, _ Optional small_circle_count As Long = 6) Dim π As Double π = WorksheetFunction.Pi ' r1:大きな円の半径。 ' r2:小さな円の半径。 ' r3:小さな円の中心からのオフセット量。 ' division_count:円周の分割数。 ' small_circle_count:小さな円の個数。 ' r1とr2の最小公倍数÷r1 ← 小さな円を何周回すか。 Dim RoundNumber As Long RoundNumber = WorksheetFunction.Lcm(r1, r2) / r1 ' 大きな円の中心座標。 Dim ox1 As Double Dim oy1 As Double ox1 = 0: oy1 = 0 ' 表の最大列数。 Dim cMax As Long cMax = 2 + 3 * small_circle_count ' グラフリセット。 Cells(1, 1).Resize(Rows.Count - 1, Columns.Count).ClearContents ' 大きい円と小さい円を分割する角度(rad)。 Dim dθ(1 To 2) As Double dθ(1) = 2 * π / division_count dθ(2) = -r1 / r2 * dθ(1) ' 全描画に必要なグラフの行数。 ' ※大きな円の描画に必要な点 division_count+1 ←始点と終点を重ねないと円が閉じない。 ' ※小さな円の描画に必要な点と動点Pの軌跡描画に必要な点の数は等しい。 Dim rMax As Long rMax = (division_count + 1) * (small_circle_count + 1) + (division_count * RoundNumber + 1) * small_circle_count + small_circle_count + 1 Dim myChart As ChartObject Set myChart = ActiveSheet.ChartObjects(1) myChart.Chart.SetSourceData Source:=Cells(1, 1).Resize(rMax + 1, cMax) myChart.Chart.ChartType = xlXYScatterSmoothNoMarkers ' グラフの書式設定。 Dim ChartIndex As Long For ChartIndex = 1 To cMax - 1 Select Case ChartIndex Case small_circle_count + 2 To 2 * small_circle_count + 1 myChart.Chart.FullSeriesCollection(ChartIndex).ChartType = xlXYScatter Case Else myChart.Chart.FullSeriesCollection(ChartIndex).ChartType = xlXYScatterSmoothNoMarkers End Select Next ' 各座標を格納するための配列。 ' 一次元を0始まりにするのは、ラベル名を格納するため。 Dim c As Long Dim arr() As Variant ReDim arr(rMax, 1 To cMax) arr(0, 1) = "X" For c = 2 To cMax arr(0, c) = "Y" & c - 1 Next ' 大きい円の座標。 Dim x1() As Double: ReDim x1(1 To division_count + 1) Dim y1() As Double: ReDim y1(1 To division_count + 1) ' 小さい円の座標。 Dim x2() As Double: ReDim x2(1 To division_count * RoundNumber + 1) Dim y2() As Double: ReDim y2(1 To division_count * RoundNumber + 1) ' 小さい円の中心。 Dim ox2() As Double: ReDim ox2(1 To division_count * RoundNumber + 1) Dim oy2() As Double: ReDim oy2(1 To division_count * RoundNumber + 1) ' 小さい円の中心からr3オフセットしたポイント。 Dim x3() As Double: ReDim x3(1 To division_count * RoundNumber + 1) Dim y3() As Double: ReDim y3(1 To division_count * RoundNumber + 1) Dim i As Long Dim j As Long Dim k As Long: k = small_circle_count ' 大きな円の描画。 For i = 1 To division_count + 1 x1(i) = r1 * Cos(dθ(1) * (i - 1)) y1(i) = r1 * Sin(dθ(1) * (i - 1)) arr(i, 1) = x1(i) arr(i, 2) = y1(i) Next ' 続けて描画するため、iの最終値を保存。 Dim LastIndex As Long LastIndex = i For i = 1 To division_count * RoundNumber + 1 Application.Wait [Now() + "00:00:00.03"] DoEvents For c = 1 To small_circle_count ' 小さな円の中心。 ox2(i) = r1 * Cos(dθ(1) * (i - 1) + 2 * π / small_circle_count * (c - 1)) * (r1 - r2) / r1 oy2(i) = r1 * Sin(dθ(1) * (i - 1) + 2 * π / small_circle_count * (c - 1)) * (r1 - r2) / r1 ' 小さい円を描画。 For j = 1 To division_count + 1 x2(i) = ox2(i) + r2 * Cos(dθ(1) * (j - 1)) y2(i) = oy2(i) + r2 * Sin(dθ(1) * (j - 1)) arr(LastIndex + j - 1 + (c - 1) * (division_count + 1), 1) = ox2(i) + r2 * Cos(dθ(1) * (j - 1)) arr(LastIndex + j - 1 + (c - 1) * (division_count + 1), c + 2) = oy2(i) + r2 * Sin(dθ(1) * (j - 1)) Next ' ' 中心からオフセットしたポイント。 x3(i) = ox2(i) + r3 * Cos(dθ(2) * (i - 1)) y3(i) = oy2(i) + r3 * Sin(dθ(2) * (i - 1)) arr(LastIndex + small_circle_count * (division_count + 1) + (c - 1), 1) = ox2(i) + r3 * Cos(dθ(2) * (i - 1)) arr(LastIndex + small_circle_count * (division_count + 1) + (c - 1), 2 + small_circle_count + c) = oy2(i) + r3 * Sin(dθ(2) * (i - 1)) arr(LastIndex + small_circle_count * (division_count + 1) + (c - 1) * (division_count * RoundNumber + 1) + k, 1) = x3(i) arr(LastIndex + small_circle_count * (division_count + 1) + (c - 1) * (division_count * RoundNumber + 1) + k, 2 + 2 * small_circle_count + c) = y3(i) Next k = k + 1 Cells(1, 1).Resize(rMax, cMax) = arr If i Mod division_count = 0 Then For ChartIndex = 1 To cMax - 1 Select Case ChartIndex Case small_circle_count + 2 To 2 * small_circle_count + 1 myChart.Chart.FullSeriesCollection(ChartIndex).ChartType = xlXYScatter Case Else myChart.Chart.FullSeriesCollection(ChartIndex).ChartType = xlXYScatterSmoothNoMarkers End Select Next End If Next End Sub
それでは、こちらで試してみよう。
Sub test() Call スピログラフ_1(17, 4, 6, , 11) End Sub
何だか、ドーナツが食べたくなりました(第一部.完)。
参考まで。