正多角形の内角の組合せ

さて、今回は厳密でない数学的テーマ。

１つの頂点に集まる正多面体の内角の総和が360度以外なら
立体的（平面以外）になります。

今回はその中でも
内角の総和が360度より小さくなる組合せのみを調べます。

iからmまでのアルファベットで5つのFor文を入れ子して
それぞれの組合せを総当りで調べます。
正多面体の内角の総和が360度より小さい組合せのみを
シートに記録します。

正ｎ角形の内角は、180-360/nです。
定数MaxAngで角が最多の正多角形を指定します。
下の例では正８角形までになっています。

コードはこちら

Sub macro101023a()
'正多角形の内角の組合わせ
'合計が360度より小さい組合わせを調べる

    Sheets.Add
    Cells(1, 1) = "合計角度"
    Cells(1, 2) = "正多角形1"
    Cells(1, 3) = "正多角形2"
    Cells(1, 4) = "正多角形3"
    Cells(1, 5) = "正多角形4"
    Cells(1, 6) = "正多角形5"
   
    Dim i, j, k, l, m
    Const MaxAng As Integer = 8
    Dim ang(5) As Integer '内角
   
    For i = 3 To 8
        ang(1) = 180 - 360 / i
        For j = i To MaxAng
            ang(2) = 180 - 360 / j
            For k = j To MaxAng
                ang(3) = 180 - 360 / k
                If ang(1) + ang(2) + ang(3) < 360 And _
                    ang(1) + ang(2) > ang(3) Then
                    Rows(2).Insert
                    Cells(2, 1) = ang(1) + ang(2) + ang(3)
                    Cells(2, 2) = i
                    Cells(2, 3) = j
                    Cells(2, 4) = k
                End If
                For l = k To MaxAng
                    ang(4) = 180 - 360 / l
                    If ang(1) + ang(2) + ang(3) + ang(4) < 360 Then
                        Rows(2).Insert
                        Cells(2, 1) = ang(1) + ang(2) + ang(3) + ang(4)
                        Cells(2, 2) = i
                        Cells(2, 3) = j
                        Cells(2, 4) = k
                        Cells(2, 5) = l
                    End If
                    For m = l To MaxAng
                        ang(5) = 180 - 360 / m
                        If ang(1) + ang(2) + ang(3) + ang(4) + ang(5) < 360 Then
                            Rows(2).Insert
                            Cells(2, 1) = ang(1) + ang(2) + ang(3) + ang(4) + ang(5)
                            Cells(2, 2) = i
                            Cells(2, 3) = j
                            Cells(2, 4) = k
                            Cells(2, 5) = l
                            Cells(2, 6) = m
                        End If
                    Next m
                Next l
            Next k
        Next j
    Next i
   
End Sub