円の内側で円を転がす ～ｎ個の円に対応（第一部．完）～

先日から、Excelでスピログラフを作成している。
infoment.hatenablog.com
今日も、昨日の続きから。

昨日は、式の一般化には成功したものの、散布図の種類設定がまずかった。
例）軌跡を描かず、点が散布されただけのパターン。

仕方ない。都度設定しなおすよう、マクロに盛り込むとしよう。
ついでにやったのが、こちら。

1. 円の径や個数などを引数にした。
2. 変数の略称を改めた（例．rn を RoundNumber とした）。
3. 背景を黒にして、雰囲気を出してみた（好みの問題）。

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 ←始点と終点を重ねないと円が閉じない。
    ' ※小さな円の描画に必要な点と動点Ｐの軌跡描画に必要な点の数は等しい。
    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
              
    ' 各座標を格納するための配列。
    ' 一次元を０始まりにするのは、ラベル名を格納するため。
    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

何だか、ドーナツが食べたくなりました（第一部．完）。

参考まで。