Option Explicit
Option Base 0
Public Sub 輪違い麻の葉文様描画マクロ()
Const RIMILEFT = 125 '描画開始位置Ｘ
Const RIMITOPP = 120 ' Ｙ
Const RIMIBEZA = 1 'ベジェ曲線倍率
'
Const RIMICOLS = 8 '描画列数
Const RIMIROWS = 5 '描画行数
Const RINISPAC = 5 '間隔
'
Const RIMILBWE = 1.5 '線の太さ
'---------------------------------------------------------------------------
Dim Ip As Integer, Jp As Integer
Dim Kp As Integer, Lp As Integer
Dim varBezi As Variant, sngBBas(2, 3, 1) As Single
Dim sngBDat(3, 1) As Single, intLen As Integer
Dim intHei As Integer, intMhe As Integer
Dim dblRad As Double, dblSit As Double
Dim intCxp As Integer, intCyp As Integer
Dim lngCol As Long
'
'ベジェ曲線データ
varBezi = Array(0, 0, 9.2, -15.8, 22.8, -15.8, 32#, 0)
'ベジェ曲線基データ作成
For Ip = LBound(varBezi, 1) To UBound(varBezi, 1) Step 2
sngBBas(0, Ip \ 2, 0) = CSng(varBezi(Ip + 0)) * RIMIBEZA
sngBBas(0, Ip \ 2, 1) = CSng(varBezi(Ip + 1)) * RIMIBEZA
Next Ip
'
'－６０° －１２０°の回転ベジェ曲線基データ作成
dblRad = ((4 * Atn(1)) / 180)
For Jp = 1 To 2
dblSit = -60 * Jp * dblRad
For Ip = 0 To 3
sngBBas(Jp, Ip, 0) = _
(sngBBas(0, Ip, 0)) * Cos(dblSit) _
- ((sngBBas(0, Ip, 1) * IIf(Jp = 1, -1, 1))) * Sin(dblSit)
sngBBas(Jp, Ip, 1) = _
(sngBBas(0, Ip, 0)) * Sin(dblSit) _
+ ((sngBBas(0, Ip, 1) * IIf(Jp = 1, -1, 1))) * Cos(dblSit)
Next Ip
Next Jp
'
lngCol = RGB(0, 139, 139) '←線色
intLen = CInt(sngBBas(0, 3, 0) - sngBBas(0, 0, 0))
intHei = CInt(intLen * Sqr(3) / 2)
intMhe = CInt(intHei * -1 * Sqr(3) / 4)
For Jp = 0 To RIMIROWS - 1
intCyp = RIMITOPP + (intHei + RINISPAC) * Jp
For Ip = 0 To RIMICOLS - 1
intCxp = RIMILEFT + (intLen \ 2 + RINISPAC) * Ip
For Kp = 0 To 2
For Lp = 0 To 3
sngBDat(Lp, 0) = sngBBas(Kp, Lp, 0) _
+ intCxp + IIf(Kp = 2, intLen, 0)
sngBDat(Lp, 1) = sngBBas(Kp, Lp, 1) + intCyp _
+ IIf((Ip + Jp) Mod 2 = 1 And Kp = 0, intMhe, 0)
Next Lp
'ベジエ曲線描画
With ActiveDocument.Shapes.AddCurve(sngBDat)
.Fill.Visible = msoFalse
.Line.Visible = msoTrue
.Line.ForeColor.RGB = lngCol '←線色
.Line.Weight = RIMILBWE '←線の太さ
If (Ip + Jp) Mod 2 = 1 Then .Flip msoFlipVertical
End With
Next Kp
Next Ip
Next Jp
End Sub
