【Word VBA】コッホ島描画マクロ▽ソースコード

Option Explicit

Option Base 0

'

Const CONSTPAI As Double = 3.14159265358979 　　'π

'

Const COCHSXPT As Integer = 300 　　　　　　　　　'描画開始位置Ｘ

Const COCHSYPT As Integer = 260　　　　　　　　    '　　　　　　Ｙ

Const COCHLENG As Integer = 8　　　　　　　　       '辺の長さ

Const COCHORDR As Integer = 3 　　　　　　　　　  '次数

Const COCHLNCL As Long = &H578B2E                    '線の色(SeaGreen)

Const COCHLNWT As Single = 1.5                            '線の太さ

'---------------------------------------------------------------

Public p_intDxp As Integer                                       '描画位置Ｘ(変数)

Public p_intDyp As Integer                                       '　　　　Ｙ(変数)

Public p_intAng As Integer                                       '描画角度　(変数)

'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*

Public Sub コッホ島描画マクロ()

    Dim Ip As Integer

    '

    p_intDxp = COCHSXPT: p_intDyp = COCHSYPT

    p_intAng = 0

    For Ip = 0 To 2

        Call コッホ島描画マクロ_回帰(COCHORDR)

         p_intAng = p_intAng - 120

    Next Ip

End Sub

'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*

Public Sub コッホ島描画マクロ_回帰(pintNum As Integer)

    Dim intExp As Integer, intEyp As Integer

    Dim dblRad As Double

    '

    If pintNum = 0 Then

       dblRad = p_intAng * CONSTPAI / 180

       intExp = p_intDxp - COCHLENG * Cos(dblRad)

       intEyp = p_intDyp + COCHLENG * Sin(dblRad)

       With ActiveDocument.Shapes.AddLine( _

            p_intDxp, p_intDyp, intExp, intEyp).Line

           .ForeColor.RGB = COCHLNCL '←線色

           .Weight = COCHLNWT '←線の太さ

       End With

       p_intDxp = intExp: p_intDyp = intEyp

       '↓時間がかかるので、挿入しました。

       DoEvents

   Else

       Call コッホ島描画マクロ_回帰(pintNum - 1)

       p_intAng = p_intAng + 60

       Call コッホ島描画マクロ_回帰(pintNum - 1)

       p_intAng = p_intAng - 120

       Call コッホ島描画マクロ_回帰(pintNum - 1)

       p_intAng = p_intAng + 60

       Call コッホ島描画マクロ_回帰(pintNum - 1)

    End If

End Sub

《蛇足》

　昨今の拙作の描画マクロは、河西朝雄著「Ｃ言語によるはじめてのアルゴリズム入門」（技術評論社）を参考に作成しています。