Option Explicit
Option Base 0
Public Sub 吉原繋ぎ文様描画マクロ()
Const YOSILEFT = 120 '描画開始位置Ｘ
Const YOSITOPP = 80 ' Ｙ
Const YOSIDISZ = 32 'ひし形の大きさ
Const YOSIDIOV = 0.38 'ひし形の重なり
Const YOSIDIWE = 4 'ひし形の枠幅
Const YOSIECSZ = 4 'ひし形隅の欠け
Const YOSIEBWE = 1.5 '重なり白線太さ
'
Const YOSIROWS = 3 'ひし形縦並びの数/2
Const YOSICOLS = 5 ' 横並びの数
'
Const YOSIDISP = 8 '横並びの間隔
'---------------------------------------------------------------------------
Dim Ip As Integer, Jp As Integer
Dim Kp As Integer, Lp As Integer
Dim intXpt As Integer, intYpt As Integer
Dim intYpw As Integer
Dim intXsp(1) As Integer, intYsp(1) As Integer
Dim lngCol As Long, dblR2H As Double
'
'
lngCol = RGB(160, 82, 45) '←線色
dblR2H = Sqr(2) / 2
For Ip = 0 To YOSICOLS - 1
intXpt = YOSILEFT + (YOSIDISZ + YOSIDISP) * Ip
For Jp = 0 To YOSIROWS - 1
intYpt = YOSITOPP + YOSIDISZ \ 2 _
+ YOSIDISZ * (2 - YOSIDIOV * 2) * Jp
'*ひし形を縦に２つ描画
For Kp = 0 To 1
intYpw = intYpt + (YOSIDISZ * (1 - YOSIDIOV)) * Kp
'*ひし形描画
With ActiveDocument.Shapes.AddShape(msoShapeDiamond, _
intXpt - YOSIDISZ \ 2, intYpw - YOSIDISZ \ 2, _
YOSIDISZ, YOSIDISZ)
.Fill.Visible = False
.Line.Visible = True
.Line.ForeColor.RGB = lngCol '←線色
.Line.Weight = YOSIDIWE '←線の太さ
End With
'
For Lp = 0 To 3
'*重なり部分処理
intXsp(0) = intXpt + ((YOSIDISZ / 4) - YOSIEBWE) _
* IIf(Lp \ 2 = 0, 1, -1) _
+ IIf(Lp Mod 2 = 0, 0, (YOSIDIWE + YOSIEBWE) * dblR2H)
intYsp(0) = intYpw - YOSIDISZ \ 2 + (YOSIDIWE \ 2) _
+ IIf(Lp Mod 2 = 0, 0, (YOSIDIWE + YOSIEBWE) * dblR2H)
intXsp(1) = intXsp(0) - YOSIDIWE * dblR2H - YOSIEBWE
intYsp(1) = intYsp(0) + YOSIDIWE * dblR2H + YOSIEBWE
If Jp <> 0 Or Kp <> 0 Then
'*白線描画
With ActiveDocument.Shapes.AddLine(intXsp(0), intYsp(0), _
intXsp(1), intYsp(1)).Line
.ForeColor.RGB = vbWhite '←線色
.Weight = YOSIEBWE '←線の太さ
End With
End If
'*四隅の凹凸処理
intXsp(0) = intXpt + (YOSIDISZ \ 2 + YOSIECSZ / 2) _
* Choose(Lp + 1, 0, 1, 0, -1)
intYsp(0) = intYpw + (YOSIDISZ \ 2 + YOSIECSZ / 2) _
* Choose(Lp + 1, -1, 0, 1, 0)
'*凹描画
With ActiveDocument.Shapes.AddShape(msoShapeDiamond, _
intXsp(0) - YOSIECSZ \ 2, intYsp(0) - YOSIECSZ \ 2, _
YOSIECSZ, YOSIECSZ)
.Fill.Visible = True
.Fill.ForeColor.RGB = vbWhite '←塗りつぶし色
.Line.Visible = False
End With
intXsp(0) = intXpt + (YOSIDISZ \ 2 + 1 - YOSIDIWE) _
* Choose(Lp + 1, 0, 1, 0, -1)
intYsp(0) = intYpw + (YOSIDISZ \ 2 + 1 - YOSIDIWE) _
* Choose(Lp + 1, -1, 0, 1, 0)
'*凸描画
With ActiveDocument.Shapes.AddShape(msoShapeDiamond, _
intXsp(0) - YOSIECSZ \ 2, intYsp(0) - YOSIECSZ \ 2, _
YOSIECSZ, YOSIECSZ)
.Fill.Visible = True
.Fill.ForeColor.RGB = lngCol '←塗りつぶし色
.Line.Visible = False
End With
Next Lp
Next Kp
Next Jp
Next Ip
End Sub
蛇足
四隅の凹の部分など、白色で塗りつぶす描画をしているので、綺麗ではありません。(^^;)
