等分された円周上の点を線で結んでみる ① 取り敢えず全部

「糸かけ曼荼羅」という言葉を、本日初めて知った。
www.itomandala.com

Excelで再現している方をお見掛けして触発されたので、私も挑戦してみた。

実際は素数を用いて作図するらしいが、今回はその前段として、とにかく全ての点を線で結んでみた。手順としては、こんな感じだ。

1. 指定した点を中心とし、同じく指定した半径の円を設定する。
2. この円周上の、指定数で等分した座標を取得する。
3. 上記座標に小さな円を配置する。
4. 各円から残り全ての円に対して、線を引く。

なお、今後どう転ぶか分からないので、描画した全ての円と線を変数にセットしてみた。また分割数が多いと、円周上に配置した円と線が重なって見難くなったので、最後に小さな円は消してみた。

Sub DrawMandara(n As Long)
    ' 元々書いてある線を削除。
    On Error Resume Next
    Sheet1.Shapes.SelectAll
    Selection.Delete

    ' 円の中心と円周上の各座標。
    Dim x() As Double: ReDim x(n + 1)
        x(0) = 500
    Dim y() As Double: ReDim y(n + 1)
        y(0) = 500
    
    ' 円の半径。
    Dim r As Double
        r = 200
    
    ' 円周上に描画する円の直径。
    Dim d As Double
        d = 15
    
    ' 円周をｎ等分した時の、一つ当たりの角度。
    Dim θ As Double
        θ = 2 * WorksheetFunction.Pi / n
    
    ' 円周上の各円。
    Dim Ovals() As Excel.Shape
    ReDim Ovals(1 To n)
    
    ' 円周上の各座標。
    Dim i As Long
        For i = 1 To n
            x(i) = x(0) + r * Sin(i * θ)
            y(i) = y(0) - r * (1 - Cos(i * θ))
            
            ' 各座標に円を描く。
            Set Ovals(i) = ActiveSheet.Shapes.AddShape(msoShapeOval, x(i), y(i), d, d)
        Next
        x(n + 1) = x(1)
        y(n + 1) = y(1)
    
    ' 各円の中心を線で結ぶ。
    Dim myConnector() As Excel.Shape
    ReDim myConnector(1 To n * (n - 1) / 2)
    Dim counter As Long: counter = 1
    Dim j As Long
        For i = 1 To n
            For j = 1 To n - i
                Set myConnector(counter) = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, x(i) + d / 2, y(i) + d / 2, x(i + j) + d / 2, y(i + j) + d / 2)
                    counter = counter + 1
            Next
            
            ' 最後に、円を消す（お好みで）。
            Ovals(i).Delete
            Application.Wait [Now() + "00:00:00.1"]
        Next
End Sub

それでは、早速実験をば。

Sub test()
    Dim n As Long
        For n = 3 To 31 Step 2
            Range("E6") = n
            DrawMandara n
        Next
End Sub

結果がこちら（※左上の数字は、円周の分割数を表す）。

糸かけ曼荼羅とは別物だが、これはこれで綺麗かも。

次回に続きます。

参考まで。