Duplicateで旋回運動

昨日は、オートシェイプを連続的に、残像付きで直線運動させてみた。
infoment.hatenablog.com
昨日が直線運動だったので、今日は旋回運動に挑戦する。

まず私の理解するところでは、回転と旋回には以下の違いがある。

• 回転：回転軸が自身の内にある
• 旋回：回転軸が自身の外にある

従って、オートシェイプの外にある点を旋回中心として、指定角度ずつ少しずつ旋回させることを考えてみた。

旋回中心の座標を（ｘ０，ｙ０）
旋回物の中心座標（ｘ１，ｙ１）

とした場合、旋回に必要な情報は

1. 旋回半径　　：ｒ
2. 旋回物の角度： θ

の二つだ。図にしてみた。

旋回半径は、三平方の定理から求める。

Function GetRadius(x0 As Double, y0 As Double, x1 As Double, y1 As Double) As Double
    GetRadius = ((x0 - x1) ^ 2 + (y0 - y1) ^ 2) ^ 0.5
End Function

旋回物の角度は、ATN2関数（アークタンジェント2）関数から求める。

Function Getθ(x0 As Double, y0 As Double, x1 As Double, y1 As Double) As Double
    Dim dx As Double
        dx = x1 - x0
    Dim dy As Double
        dy = y1 - y0
        Getθ = WorksheetFunction.Atan2(dx, dy)
End Function

これを踏まえて、反時計回りに１0°刻みで旋回するマクロを作ってみた。
※1/22に一部修正。

Sub RotateShape()

    Dim iMax As Long: iMax = 200
    Dim Shapes() As Shape
    ReDim Shapes(iMax)
    
    Set Shapes(0) = ActiveSheet.Shapes.AddShape(msoShapeOval, 350, 350, 30, 30)
        Shapes(0).ShapeStyle = msoShapeStylePreset37
        
    Dim x0 As Double: x0 = 500
    Dim y0 As Double: y0 = 500
    
    Dim x1 As Double
    Dim y1 As Double
    
    Dim r As Double
    Dim after_image As Long
        after_image = 10
        
    Dim θ As Double
    Dim dx As Double
    Dim dy As Double
    
    Dim i As Long
        For i = 1 To iMax + after_image
            If i <= iMax Then
                Application.Wait [now()+"0:00:00.01"]
                Set Shapes(i) = Shapes(i - 1).Duplicate
                Shapes(i - 1).Fill.Transparency = 0.8
                x1 = Shapes(i).Left + 15
                y1 = Shapes(i).Top + 15
        
                r = GetRadius(x0, y0, x1, y1)
                θ = Getθ(x0, y0, x1, y1)
                dx = r * (Cos(θ - 10 * WorksheetFunction.Pi / 180) - Cos(θ))
                dy = r * (Sin(θ - 10 * WorksheetFunction.Pi / 180) - Sin(θ))

            
                Shapes(i).IncrementLeft dx
                Shapes(i).IncrementTop dy
            End If
            
            If i >= after_image Then
                Application.Wait [now()+"0:00:00.01"]
                Shapes(i - after_image).Delete
            End If
        Next

End Sub

結果が↓こちら。

ランダムに動くのも良いけど、こういうのも良いかもしれない。

次回に続きます。

参考まで。