Option Explicit
Option Base 0
Public Sub 捻じ麻の葉文様描画マクロ()
Const TWHPLEFT = 80 '描画開始位置Ｘ
Const TWHPTOPP = 100 ' Ｙ
Const TWHPPLYS = 5 'ポリライン倍率
'
Const TWHPROWS = 5 '縦描画数
Const TWHPCOLS = 6 '横描画数
Const TWHPLNWE = 2 '線の太さ
'---------------------------------------------------------------------------
Dim Ip As Integer, Jp As Integer
Dim Kp As Integer, Lp As Integer
Dim intCXp As Integer, intCYp As Integer
Dim intDXp As Integer, intDYp As Integer
Dim sngPBas(5, 1) As Single, sngPDat(5, 1) As Single
Dim sngPTmp(2, 5, 1) As Single
Dim dblRev As Double, dblRad As Double
Dim dblSit As Double, lngCol As Long
'
lngCol = RGB(220, 20, 60) '←線色/深紅
'*ポリラインベースデータ
sngPBas(0, 0) = 0: sngPBas(0, 1) = 0
sngPBas(1, 0) = 1: sngPBas(1, 1) = Sqr(3)
sngPBas(2, 0) = 3: sngPBas(2, 1) = Sqr(3)
sngPBas(3, 0) = 4: sngPBas(3, 1) = 0
sngPBas(4, 0) = 6: sngPBas(4, 1) = 0
sngPBas(5, 0) = 7: sngPBas(5, 1) = Sqr(3)
'
dblRad = ((4 * Atn(1)) / 180): dblRev = Atn(Sqr(3) / 7)
'０°－６０° －１２０°に回転
For Kp = 0 To 2
dblSit = -60 * Kp * dblRad - dblRev
For Lp = 0 To 5
sngPTmp(Kp, Lp, 0) = (sngPBas(Lp, 0) * Cos(dblSit) _
- sngPBas(Lp, 1) * Sin(dblSit)) * TWHPPLYS
sngPTmp(Kp, Lp, 1) = (sngPBas(Lp, 0) * Sin(dblSit) _
+ sngPBas(Lp, 1) * Cos(dblSit)) * TWHPPLYS
Next Lp
Next Kp
'
For Jp = 0 To TWHPROWS - 1
intCYp = TWHPTOPP + Abs(sngPTmp(2, 5, 1)) + Jp _
* Abs(sngPTmp(1, 5, 1))
For Ip = 0 To TWHPCOLS - 1
intCXp = TWHPLEFT + Ip * sngPTmp(0, 5, 0) _
- sngPTmp(1, 5, 0) * (Jp Mod 2)
For Kp = 0 To 2
If (Ip <> 0 Or Kp <> 2) Then
For Lp = 0 To 5
sngPDat(Lp, 0) = sngPTmp(Kp, Lp, 0) + intCXp
sngPDat(Lp, 1) = sngPTmp(Kp, Lp, 1) + intCYp
Next Lp
With ActiveDocument.Shapes.AddPolyline(sngPDat)
.Fill.Visible = msoFalse
.Line.Visible = msoTrue
.Line.ForeColor = lngCol '←線色
.Line.Weight = TWHPLNWE '←線の太さ
End With
End If
Next Kp
Next Ip
Next Jp
End Sub
