【Word VBA】ジオメトリー柄描画マクロ其の二▽ソースコード

Option Explicit

Option Base 0

'

Public Sub ジオメトリー柄描画マクロ其の二()

    Const GEOMLEFT = 100　　        '描画開始位置Ｘ

    Const GEOMTOPP = 110 　　　　 '　　　　　　Ｙ

    '

    Const GEOMCOLS = 7                '横/描画数

    Const GEOMROWS = 4               '縦/描画数

    '

    Const GEOMPRAT = 0.75            'ポリライン倍率

    Const GEOMVPIT = 35 * GEOMPRAT      '横-間隔

    Const GEOMHPIT = 60 * GEOMPRAT      '縦-間隔

    Const GEOMREVI = -20 * GEOMPRAT     '反転位置補正

    '

    Const GEOMLNCL = &HE22B8A             '線の色(Blue Violet)

    Const GEOMLNWE = 1.5                       '線の太さ

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

    Dim Ip As Integer, Jp As Integer

    Dim Kp As Integer, Lp As Integer

    Dim Mp As Integer

    '

    Dim intDxp As Integer, intDyp As Integer

    Dim intEyp As Integer

    Dim varPoly As Variant

    Dim sngPBas() As Single, sngPDat() As Single

    Dim sngPAng() As Single

    Dim sngRad As Single, sngSit As Single

   '

    varPoly = Array(0, 0, -10, 0, -20, -20, 35, -20)

    ReDim sngPBas((UBound(varPoly, 1) - 1) \ 2, 1)

    '

    '*ポリラインデータ設定

    ReDim sngPDat((UBound(varPoly, 1) - 1) \ 2, 1)

    For Kp = LBound(varPoly, 1) To UBound(varPoly, 1) Step 2

        sngPBas(Kp \ 2, 0) = CSng(varPoly(Kp + 0)) * GEOMPRAT

        sngPBas(Kp \ 2, 1) = CSng(varPoly(Kp + 1)) * GEOMPRAT

    Next Kp '

    '

    '*ポリラインデータ設定－三角形＋逆三角形

    ReDim sngPAng(1, 2, (UBound(varPoly, 1) - 1) \ 2, 1)

    sngRad = 60 * ((4 * Atn(1)) / 180):

    For Ip = 0 To 2

        sngSit = Ip * sngRad

        For Kp = LBound(sngPBas, 1) To UBound(sngPBas, 1)

            sngPAng(0, Ip, Kp, 0) = (sngPBas(Kp, 0) * Cos(sngSit) _

                      - sngPBas(Kp, 1) * Sin(sngSit)) * IIf(Ip = 1, 1, -1)

            sngPAng(0, Ip, Kp, 1) = (sngPBas(Kp, 0) * Sin(sngSit) _

                      + sngPBas(Kp, 1) * Cos(sngSit)) * IIf(Ip = 1, 1, -1)

            sngPAng(1, Ip, Kp, 0) = (sngPBas(Kp, 0) * Cos(sngSit) _

            - (sngPBas(Kp, 1) * -1) * Sin(sngSit)) * IIf(Ip = 1, 1, -1)

            sngPAng(1, Ip, Kp, 1) = (sngPBas(Kp, 0) * Sin(sngSit) _

            + (sngPBas(Kp, 1) * -1) * Cos(sngSit)) * IIf(Ip = 1, 1, -1)

        Next Kp

    Next Ip

    '

    '*柄描画

    For Jp = 0 To GEOMROWS - 1

        intDyp = GEOMTOPP + GEOMHPIT * Jp

        For Ip = 0 To GEOMCOLS - 1

            intDxp = GEOMLEFT + GEOMVPIT * Ip

            Mp = (Ip + Jp) Mod 2 '←△(0)or▽(1)

            intEyp = GEOMREVI * Mp

            For Lp = 0 To 2

                '*ポリライン位置設定

                For Kp = LBound(sngPDat, 1) To UBound(sngPDat, 1)

                    sngPDat(Kp, 0) = sngPAng(Mp, Lp, Kp, 0) + intDxp

                    sngPDat(Kp, 1) = sngPAng(Mp, Lp, Kp, 1) + intDyp _

                                                                                 + intEyp

                Next Kp

                '*ポリライン描画

                With ActiveDocument.Shapes.AddPolyline(sngPDat)

                   .Fill.Visible = msoFalse

                   .Line.Visible = msoTrue

                   .Line.ForeColor = GEOMLNCL '←線色

                   .Line.Weight = GEOMLNWE '←線の太さ

               End With

           Next Lp

        Next Ip

    Next Jp

End Sub

《蛇足》

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