線を引いて動かす ⑧ まとめ

中学数学の図形問題説明のため、Excelで線を引き動かしてみた。
infoment.hatenablog.com

今日は、これらを纏めてみる。

前回は、この５つの角の総和を求める方法を三通り紹介した。

しかし勿論、他にも方法があると思う。例えば、こんな感じだ。

黄と緑は０°となり、青は「対頂角は等しい」により、このようになる。

この解法でも、５角の総和が180°であることが直感的に理解できるだろう。

さて、それでは７回にわたり作りこんだコードを、今回はまとめて掲載。

Function GetLine(Sx As Double, _
                 Sy As Double, _
                 Ex As Double, _
                 Ey As Double) As Shape
    Set GetLine = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, _
                                                  Sx, Sy, _
                                                  Ex, Ey)
End Function

Function GetPosisionArray(target_shape As Variant) As Variant
        If Not TypeName(target_shape) = "Shape" Then
            GetPosisionArray = Array()
            Exit Function
        End If
    
    Dim Sx As Double
    Dim Sy As Double
    Dim Ex As Double
    Dim Ey As Double
        Select Case target_shape.HorizontalFlip
            Case True
                Sx = target_shape.Left + target_shape.Width
                Ex = target_shape.Left
            Case False
                Sx = target_shape.Left
                Ex = target_shape.Left + target_shape.Width
        End Select
        
        Select Case target_shape.VerticalFlip
            Case True
                Sy = target_shape.Top + target_shape.Height
                Ey = target_shape.Top
            Case False
                Sy = target_shape.Top
                Ey = target_shape.Top + target_shape.Height
        End Select
        
        GetPosisionArray = Array(Sx, Sy, Ex, Ey)
End Function

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 MoveLine(ByVal start_position_array As Variant, _
             ByVal end_position_array As Variant, _
             Optional moving_times As Long = 30, _
             Optional delete_flag As Boolean = False)
    
    ReDim Preserve start_position_array(1 To UBound(start_position_array) - LBound(start_position_array) + 1)
    ReDim Preserve end_position_array(1 To UBound(end_position_array) - LBound(end_position_array) + 1)
    
    Dim LineNumber As Long
        LineNumber = UBound(start_position_array)
    
    ' 始点のx,y座標。
    Dim Sx() As Double: ReDim Sx(1 To LineNumber, moving_times)
    Dim Sy() As Double: ReDim Sy(1 To LineNumber, moving_times)
    ' 終点のx,y座標
    Dim Ex() As Double: ReDim Ex(1 To LineNumber, moving_times)
    Dim Ey() As Double: ReDim Ey(1 To LineNumber, moving_times)
    ' 一回当たりの移動量（始点）
    Dim dSx() As Double: ReDim dSx(1 To LineNumber)
    Dim dSy() As Double: ReDim dSy(1 To LineNumber)
    ' 一回当たりの移動量（終点）
    Dim dEx() As Double: ReDim dEx(1 To LineNumber)
    Dim dEy() As Double: ReDim dEy(1 To LineNumber)
    
    Dim myLine() As Shape: ReDim myLine(1 To LineNumber, moving_times)

    Dim i As Long
    Dim j As Long
        For i = 1 To LineNumber
    
            ' 初期値設定
            Sx(i, 0) = WorksheetFunction.Index(start_position_array(i), 1)
            Sy(i, 0) = WorksheetFunction.Index(start_position_array(i), 2)
            Ex(i, 0) = WorksheetFunction.Index(start_position_array(i), 3)
            Ey(i, 0) = WorksheetFunction.Index(start_position_array(i), 4)
        
            ' 移動後の座標設定。
            Sx(i, moving_times) = WorksheetFunction.Index(end_position_array(i), 1)
            Sy(i, moving_times) = WorksheetFunction.Index(end_position_array(i), 2)
            Ex(i, moving_times) = WorksheetFunction.Index(end_position_array(i), 3)
            Ey(i, moving_times) = WorksheetFunction.Index(end_position_array(i), 4)
        

            dSx(i) = (Sx(i, moving_times) - Sx(i, 0)) / moving_times
            dSy(i) = (Sy(i, moving_times) - Sy(i, 0)) / moving_times
    
            dEx(i) = (Ex(i, moving_times) - Ex(i, 0)) / moving_times
            dEy(i) = (Ey(i, moving_times) - Ey(i, 0)) / moving_times

            For j = 1 To moving_times - 1
                Sx(i, j) = Sx(i, j - 1) + dSx(i)
                Sy(i, j) = Sy(i, j - 1) + dSy(i)
                Ex(i, j) = Ex(i, j - 1) + dEx(i)
                Ey(i, j) = Ey(i, j - 1) + dEy(i)
            Next
        
        Next
    
        ' 設定した移動回数で変形。
        For j = 0 To moving_times
            For i = 1 To LineNumber
                Set myLine(i, j) = GetLine(Sx(i, j), Sy(i, j), Ex(i, j), Ey(i, j))
                If delete_flag Then
                    On Error Resume Next
                    myLine(i, j - 1).Delete
                End If
                Application.Wait [Now() + "00:00:00.01"]
            Next
        Next

End Sub

今回のシリーズも、これが出来たからと言って業務の足しになる訳ではない。
でも、まあ面白かったから、良しとしよう。

ということで、本シリーズはこれでおしまいです。

参考まで。