Option Explicit
Option Base 0
'
Public Sub ジオメトリー柄描画マクロ其の三()
Const GEOMLEFT = 100 '描画開始位置X
Const GEOMTOPP = 110 ' Y
'
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, Mp As Integer
'
Dim intDxp As Integer, intDyp As Integer
Dim intEyp As Integer, 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, 5, 8, 5, -20, -15, -20, -25, -3)
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
《蛇足》
昨今の拙作の描画マクロは、河西朝雄著「C言語によるはじめてのアルゴリズム入門」(技術評論社)を参考に作成しています。