Duplicateで旋回運動の続き：残像＋分身 - Infomentのブログ～Excel VBA奮闘記～

昨日は、円を旋回運動させるマクロにおいて、残像に加え分身を配置することに挑戦した。
infoment.hatenablog.com
しかし、これが中々上手くいかない。思い切って、考え方を逆にしてみた。
f:id:Infoment:20190126125239p:plain
今までは、下記のような手順で作成していた。

最初に、限定的な場合について仕組みを作る。
次いで、一般的な場合について拡張する。

このやり方がダメだとは、今も思っていない。しかし今回は、
一般化に当たって修正点が多すぎて、検証が難化した。そこで、
次のように考え方を逆にしてみた。

最初に、一般的な場合（例えば「複数の分身がある」）の仕組みを作る。
限定的な場合（例えば「１個のとき」）は、特殊解として一般式に含まれる。

結果、このように作り替えた。

クラスモジュール（DuplicateShapeClass）

Option Explicit

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Enum AngleType
    myDeg   ' ※１回転で360°
    myRad   ' ※１回転で2π
End Enum

Public x0 As Double
Public y0 As Double
Public RotateRadius As Double
Public RotateShapeRadius As Double
Public PhantomNumber As Long

Dim StartAngles() As Double

Private Property Get π() As Double
    π = WorksheetFunction.Pi
End Property

Public Sub GetStartAngle(angle_value As Double, angle_type As AngleType)

    If PhantomNumber = 0 Then PhantomNumber = 1
    ReDim StartAngles(PhantomNumber - 1)

    Dim i As Long
    For i = 0 To PhantomNumber - 1
        Select Case angle_type
            Case myDeg
                StartAngles(i) = (angle_value + 360 / PhantomNumber * i) * π / 180
            Case myRad
                StartAngles(i) = angle_value + 2 * π * i / PhantomNumber
        End Select
    Next
End Sub

Private Function SetStartShape(phantom_index As Long) As Shape
    Dim r As Double
        r = RotateShapeRadius
        If r = 0 Then r = 30
    
    Dim x As Double
    Dim y As Double
    
        x = x0 - RotateRadius * Cos(StartAngles(phantom_index)) + r / 2
        y = y0 - RotateRadius * Sin(StartAngles(phantom_index)) + r / 2

        
        Set SetStartShape = ActiveSheet.Shapes.AddShape(msoShapeOval, x, y, r, r)
End Function

Sub RotateShape(Optional rotation_number As Long = 1, _
                Optional rotation_angle As Double = 5, _
                Optional after_image As Long = 10)

    If PhantomNumber = 0 Then PhantomNumber = 1
    after_image = after_image * PhantomNumber

    Dim iMax As Long
        iMax = (rotation_number * 360 / rotation_angle) * PhantomNumber
    Dim Shapes() As Shape
    ReDim Shapes(iMax)
    
        If RotateRadius = 0 Then
            RotateRadius = 200
        End If
    
    Dim θ1() As Double
    ReDim θ1(PhantomNumber)
    Dim θ2() As Double
    ReDim θ2(PhantomNumber)
    
    Dim i As Long
        For i = 0 To PhantomNumber - 1
            Set Shapes(i) = SetStartShape(i)
                Shapes(i).ShapeStyle = msoShapeStylePreset37
            θ1(i) = StartAngles(i)
            θ2(i) = θ1(i) - rotation_angle * π / 180
        Next
        
    Dim dx As Double
    Dim dy As Double
    Dim PhantomIndex As Long
    
        For i = PhantomNumber To iMax + after_image
'            Sleep 1
            If i <= iMax Then
                Set Shapes(i) = Shapes(i - PhantomNumber).Duplicate
                Shapes(i - PhantomNumber).Fill.Transparency = 0.8
                
                PhantomIndex = i Mod PhantomNumber
                
                dx = RotateRadius * (Cos(θ2(PhantomIndex)) - Cos(θ1(PhantomIndex)))
                dy = RotateRadius * (Sin(θ2(PhantomIndex)) - Sin(θ1(PhantomIndex)))
            
                Shapes(i).Left = Shapes(i - PhantomNumber).Left - dx
                Shapes(i).Top = Shapes(i - PhantomNumber).Top - dy
                
                θ1(PhantomIndex) = θ2(PhantomIndex)
                θ2(PhantomIndex) = θ1(PhantomIndex) - rotation_angle * π / 180
                
            End If
            
            If i >= after_image Then
                Shapes(i - after_image).Delete
            End If
            Application.Wait [now()+"0:00:00.01"]
        Next

End Sub

標準モジュール

テストのためのマクロ。

Sub RotateTest()
    Dim DSC As DuplicateShapeClass
    Set DSC = New DuplicateShapeClass
        DSC.x0 = 400
        DSC.y0 = 300
        DSC.RotateRadius = 200
        DSC.RotateShapeRadius = 30
        
        Dim i As Long
        For i = 1 To 10
            DSC.PhantomNumber = i
            Call DSC.GetStartAngle(90, myDeg)
            Call DSC.RotateShape(rotation_number:=1, _
                                 rotation_angle:=5 * i, _
                                 after_image:=5)
        Next
End Sub