線を引いて動かす ⑥ 正多角形を描いてみる - Infomentのブログ～Excel VBA奮闘記～

ある理由から唐突に、Excelで線を引いて、それを動かしたくなった。
前回は、既存の線の始点と終点座標を得る関数を作成してみた。
infoment.hatenablog.com

色々と試す中で、どうせなら正多角形を描いてみたくなった。
f:id:Infoment:20200911195408p:plain

今回の作戦はこうだ。
円に内接する正ｎ角形を描画する。そのために、

円の中心座標と、円の半径ｒを与える。
360度をｎで割って、頂点間の角度θを求める。
ｒｓｉｎ（ｉθ）とｒｃｏｓ（ｉθ）で、ｉ番目の座標を求める。
ｉ番目とｉ＋１番目を線で結ぶ。

※この場合のｉは、虚数ｉではなく、ループカウンタのｉ。

実際のコードがこちら。なお、正三角形の頂点が上になるよう、幾つか小細工している。

Function DrawRegularPolygon(Optional vertex_number As Long = 6, _
                            Optional radius As Double = 100, _
                            Optional Ox As Double = 300, _
                            Optional Oy As Double = 300) As Boolean

    Dim θ As Double
        θ = 2 * WorksheetFunction.Pi / vertex_number
        
    Dim Sx() As Double: ReDim Sx(1 To vertex_number)
    Dim Sy() As Double: ReDim Sy(1 To vertex_number)
    Dim Ex() As Double: ReDim Ex(1 To vertex_number)
    Dim Ey() As Double: ReDim Ey(1 To vertex_number)
        
    Dim i As Long
        For i = 1 To vertex_number
            Ex(i) = Ox - Sin((i - 1) * θ) * radius
            Ey(i) = Oy - Cos((i - 1) * θ) * radius
            Select Case i
                Case 1
                Case Else
                    Sx(i) = Ex(i - 1)
                    Sy(i) = Ey(i - 1)
            End Select
        Next
        
        Sx(1) = Ex(vertex_number)
        Sy(1) = Ey(vertex_number)
        
        For i = 1 To vertex_number
            GetLine Sx(i), Sy(i), Ex(i), Ey(i)
        Next
        
End Function

それではこちらで、連続的に正多角形を描いてみよう。

Sub test()

    Dim i As Long
        For i = 1 To ActiveSheet.Shapes.Count
            MoveLine GetPosisionArray(ActiveSheet.Shapes(i)), _
                     GetPosisionArray(ActiveSheet.Shapes(i + 1))
        Next
        
        MoveLine GetPosisionArray(ActiveSheet.Shapes(i)), _
                 GetPosisionArray(ActiveSheet.Shapes(1))
    
End Sub

Sub test2()
    Dim i As Long
        For i = 3 To 6
            ActiveSheet.Shapes.SelectAll
            Selection.Delete
            DrawRegularPolygon i

            Call test
        Next
End Sub