円の内側で円を転がす ～もう少し滑らかに～

前回は、円の内側で小さな円を転がすことに挑戦した。
infoment.hatenablog.com

今日は、これを少し改善するお話。

前回作ってみて感じた問題点は、以下の二つ。

1. 小さな円が自転しているように見えない（公転だけ）
2. 動きがカクカクしていて、滑らかでない

ということで、以下の改善を行った。

1. 小さな円内に、その中心以外の一点を描画する。
2. 座標は一旦配列に格納し、まとめて貼り付けることで
   画面の更新回数を減らす。

↓ 上記の１．は、こんなイメージになる。

色々と試行錯誤して、今のところ ↓ に落ち着いた。

Sub ぐるぐる()

        Cells(2, 1).Resize(Rows.Count - 1, 4).Clear
    
    Dim π As Double
        π = WorksheetFunction.Pi
    
    Dim r(1 To 3) As Double
        ' 大きな円の半径。
        r(1) = 40
        ' 小さな円の半径。
        r(2) = 10
        ' 小さな円の中心からのオフセット量。
        r(3) = 8
        
    Dim ox1 As Double
    Dim oy1 As Double
        ' 大きな円の中心座標。
        ox1 = 0: oy1 = 0
      
    Dim dc As Double
        ' 円周の分割数（Division Count）
        dc = 108
        
    Dim dθ(1 To 2) As Double
        dθ(1) = 2 * π / dc
        dθ(2) = -r(1) / r(2) * dθ(1)
        
    
    ' 大きい円の座標。
    Dim x1() As Double: ReDim x1(1 To dc + 1)
    Dim y1() As Double: ReDim y1(1 To dc + 1)
    ' 小さい円の座標。
    Dim x2() As Double: ReDim x2(1 To dc + 1)
    Dim y2() As Double: ReDim y2(1 To dc + 1)
    ' 小さい円の中心。
    Dim ox2() As Double: ReDim ox2(1 To dc + 1)
    Dim oy2() As Double: ReDim oy2(1 To dc + 1)
    ' 小さい円の中心からr(3)オフセットしたポイント。
    Dim x3() As Double: ReDim x3(1 To dc + 1)
    Dim y3() As Double: ReDim y3(1 To dc + 1)
        
    Dim i As Long
    Dim j As Long

    Dim arr() As Variant
    ReDim arr(1 To (dc + 1) * 2 + 2, 1 To 4)

        ' 大きな円の描画。
        For i = 1 To dc + 1
            x1(i) = r(1) * Cos(dθ(1) * (i - 1))
            y1(i) = r(1) * 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 dc + 1
            ' 小さな円の中心。
            ox2(i) = x1(i) * (r(1) - r(2)) / r(1)
            oy2(i) = y1(i) * (r(1) - r(2)) / r(1)

            Application.Wait [Now() + "00:00:00.03"]
            DoEvents
            
            ' 小さい円を描画。
            For j = 1 To dc + 1
                x2(i) = ox2(i) + r(2) * Cos(dθ(1) * (j - 1))
                y2(i) = oy2(i) + r(2) * Sin(dθ(1) * (j - 1))
                arr(LastIndex + j, 1) = x2(i)
                arr(LastIndex + j, 3) = y2(i)
            Next
            
            ' 中心からオフセットしたポイント。
            x3(i) = ox2(i) + r(3) * Cos(dθ(2) * (i) - 1)
            y3(i) = oy2(i) + r(3) * Sin(dθ(2) * (i) - 1)
            arr(LastIndex + j, 1) = x3(i)
            arr(LastIndex + j, 4) = y3(i)
            
            Cells(2, 1).Resize(UBound(arr), 4) = arr
        Next

End Sub

結果は、こんな感じだ。

もう少し、面白くできそうです。

参考まで。