スプライン曲線で正弦波を作成するマクロ｜AutoCAD VBAマクロの作成方法

AutoCADできれいな波線を作図するのは少し面倒ですが、VBAを使うことで一瞬で作成することが可能になります。ここではVBAとスプライン曲線を使って正弦波を作成する方法を解説します。
　

1. マクロ機能
2. サンプルコード
3. コード解説　
4. まとめ

マクロ機能

マクロの機能まとめ・モデル空間に存在するユーザーが選択した線分に対して正弦波を作成する
・作成する波形の波長と振幅はコード内で変更可能
・正弦波を作成する範囲は入力された線分の長さに収まるように自動調整する
・入力された線分は水平である必要なし (傾いていても作成可能)

「正弦波」と記載していますが、振幅が0もしくは最大最小値となる点を通るようなスプラインで疑似的な波形を作成しているだけのため、数学的には正確な正弦波とはなっていないのでご注意ください。
　

サンプルコード

マクロのサンプルコードは下記のとおりです。事前にアクティブドキュメントのモデル空間に線分を作成しておく必要があります。マクロ実行後、ユーザーの選択待ち状態となるので対象の線分を選択することでその線分を基準とした正弦波を作成することができます。

Option Explicit
'********************************************************************
'*  ﾒｲﾝ処理
'********************************************************************
Sub main()

    Const AMPLITUDE As Double = 500     '振幅
    Const WAVELENGTH As Double = 1000   '波長
 
    Dim oEntity As AcadEntity
    Dim oLine As AcadLine
    Dim oSpline As AcadSpline

    'ﾕｰｻﾞｰ選択で線分取得
    On Error Resume Next
    Call ThisDrawing.Utility.GetEntity(oEntity, Empty, "正弦波の基準とする線分を選択")
    On Error GoTo 0
    If TypeName(oEntity) <> "IAcadLine" Then Exit Sub
    Set oLine = oEntity
    
    'ｽﾌﾟﾗｲﾝで正弦波作成
    Set oSpline = CreateSinWave(oLine, AMPLITUDE, WAVELENGTH)

End Sub
'--------------------------------------------------------------------
'-  正弦波を作成する
'-      oLine       ：基準の線分
'-      dAmplitude  ：振幅
'-      dWaveLength ：波長
'-      戻り値      ：作成した正弦波ｽﾌﾟﾗｲﾝ
'--------------------------------------------------------------------
Private Function CreateSinWave(ByVal oLine As AcadLine, _
                               ByVal dAmplitude As Double, _
                               ByVal dWaveLength As Double) As AcadSpline
    
    Dim oSpline As AcadSpline
    Dim dLength As Double
    Dim lCntCtrlPt As Long
    Dim dSplinePt() As Double
    Dim dTangent(2) As Double
    Dim vPtStart As Variant
    Dim vPtEnd As Variant
    Dim vPtFit As Variant
    Dim vVecLine As Variant
    Dim vVecNorm As Variant
    Dim lInverse As Long
    Dim i As Long
    Dim j As Long
    Dim lIdx As Long
    
    
    '始終点座標を取得
    vPtStart = oLine.StartPoint
    vPtEnd = oLine.EndPoint
    
    '線分方向ﾍﾞｸﾄﾙおよび線分の垂直方向ﾍﾞｸﾄﾙを取得
    vVecLine = CalculateVectorDirection(vPtStart(0), vPtStart(1), vPtEnd(0), vPtEnd(1))
    vVecNorm = CalculateRotateVector(vVecLine(0), vVecLine(1), 90)
    
    '線分長さからｽﾌﾟﾗｲﾝのﾌｨｯﾄ点の数を取得 (※必ず奇数とする)
    dLength = Sqr(vVecLine(0) * vVecLine(0) + vVecLine(1) * vVecLine(1))
    lCntCtrlPt = dLength \ (dWaveLength / 4) + 1
    If lCntCtrlPt Mod 2 = 0 Then
        lCntCtrlPt = lCntCtrlPt - 1
    End If
    
    'ｽﾌﾟﾗｲﾝのﾌｨｯﾄ点の数に合わせて配列ｻｲｽﾞ変更
    ReDim dSplinePt(lCntCtrlPt * 3 - 1)
    
    'ｽﾌﾟﾗｲﾝのﾌｨｯﾄ点の数だけﾙｰﾌﾟ
    For i = 0 To lCntCtrlPt - 1
    
        If i = 0 Then
            '初回ﾙｰﾌﾟは線分の始点座標を配列に格納
            For j = 0 To 2
                dSplinePt(lIdx) = vPtStart(j)
                lIdx = lIdx + 1
            Next

        Else
            '偶数番目のﾌｨｯﾄ点は線分上
            If i Mod 2 = 0 Then
                lInverse = 0
                
            '奇数番目のﾌｨｯﾄ点は上下を交互に切り替え
            Else
                If i Mod 4 = 1 Then
                    lInverse = 1
                Else
                    lInverse = -1
                End If
            End If
        
            'i番目のﾌｨｯﾄ点の座標を計算で求める
            vPtFit = CalculateEndPoint(vPtStart(0), vPtStart(1), vVecLine(0), vVecLine(1), dWaveLength / 4 * i) '波長方向
            vPtFit = CalculateEndPoint(vPtFit(0), vPtFit(1), vVecNorm(0), vVecNorm(1), lInverse * dAmplitude)   '振幅方向
            
            '計算結果のﾌｨｯﾄ点座標を配列に格納
            ReDim Preserve vPtFit(2)
            For j = 0 To 2
                dSplinePt(lIdx) = vPtFit(j)
                lIdx = lIdx + 1
            Next
        End If
    Next
    
    '取得した座標値をもとにｽﾌﾟﾗｲﾝ作成
    Set oSpline = ThisDrawing.ModelSpace.AddSpline(dSplinePt, dTangent, dTangent)
    
    '描画更新
    ThisDrawing.Regen acActiveViewport
    
    Set CreateSinWave = oSpline

End Function
'--------------------------------------------------------------------
'-  始点座標と方向成分、長さから終点座標を計算する
'-      dX      ：始点X座標
'-      dY      ：始点Y座標
'-      dDirX   ：X方向成分
'-      dDirY   ：Y方向成分
'-      dLength ：長さ
'-      戻り値  ：終点のXY座標が入った配列
'--------------------------------------------------------------------
Private Function CalculateEndPoint(ByVal dStartX As Double, ByVal dStartY As Double, _
                                   ByVal dDirX As Double, ByVal dDirY As Double, _
                                   ByVal dLength As Double) As Double()
    Dim dCoordEnd(1) As Double
    Dim dMagnitude As Double
    Dim dVecUnitX As Double
    Dim dVecUnitY As Double
    Dim dEndX As Double
    Dim dEndY As Double
    
    '方向ﾍﾞｸﾄﾙの大きさを計算
    dMagnitude = Sqr(dDirX * dDirX + dDirY * dDirY)
    
    '単位ﾍﾞｸﾄﾙを計算
    dVecUnitX = dDirX / dMagnitude
    dVecUnitY = dDirY / dMagnitude
    
    '終点の座標を計算
    dEndX = dStartX + dVecUnitX * dLength
    dEndY = dStartY + dVecUnitY * dLength
    
    dCoordEnd(0) = dEndX
    dCoordEnd(1) = dEndY
    
    '結果を配列として返す
    CalculateEndPoint = dCoordEnd
    
End Function
'--------------------------------------------------------------------
'-  始終点座標からﾍﾞｸﾄﾙ方向成分を計算する
'-      dStartX     ：始点X座標
'-      dStartY     ：始点Y座標
'-      dEndX       ：終点X座標
'-      dEndY       ：終点Y座標
'-      (flgUnit)   ：単位ﾍﾞｸﾄﾙ化ﾌﾗｸﾞ
'-      戻り値      ：ﾍﾞｸﾄﾙ方向成分が入った配列
'--------------------------------------------------------------------
Private Function CalculateVectorDirection(ByVal dStartX As Double, ByVal dStartY As Double, _
                                          ByVal dEndX As Double, ByVal dEndY As Double, _
                                          Optional flgUnit As Boolean = False) As Double()
    Dim dVector(1) As Double
    Dim dMagnitude As Double
    Dim dVecX As Double
    Dim dVecY As Double
    
    'ﾍﾞｸﾄﾙ成分を計算
    dVector(0) = dEndX - dStartX
    dVector(1) = dEndY - dStartY
    
    '単位ﾍﾞｸﾄﾙに変換
    If flgUnit = True Then
        dMagnitude = Sqr(dVector(0) * dVector(0) + dVector(1) * dVector(1))
        dVector(0) = dVector(0) / dMagnitude
        dVector(1) = dVector(1) / dMagnitude
    End If
    
    CalculateVectorDirection = dVector

End Function
'--------------------------------------------------------------------
'-  ﾍﾞｸﾄﾙ方向成分と角度から回転したﾍﾞｸﾄﾙの方向成分を計算する
'-      dVecX       ：ﾍﾞｸﾄﾙX方向成分
'-      dVecY       ：ﾍﾞｸﾄﾙY方向成分
'-      dAngle      ：角度
'-      戻り値      ：回転後のﾍﾞｸﾄﾙ方向成分が入った配列
'--------------------------------------------------------------------
Private Function CalculateRotateVector(ByVal dVecX As Double, ByVal dVecY As Double, _
                                       ByVal dAngle As Double) As Double()

    Const PI As Double = 3.1415926535 '円周率
    
    Dim dVector(1) As Double
    Dim dRadian As Double
    
    '角度をﾗｼﾞｱﾝに変換
    dRadian = dAngle * (PI / 180)

    '回転ﾍﾞｸﾄﾙを計算
    dVector(0) = dVecX * Cos(dRadian) - dVecY * Sin(dRadian)
    dVector(1) = dVecX * Sin(dRadian) + dVecY * Cos(dRadian)

    CalculateRotateVector = dVector
    
End Function

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

Option Explicit

'********************************************************************

'* ﾒｲﾝ処理

'********************************************************************

Sub main()

Const AMPLITUDE As Double = 500 '振幅

Const WAVELENGTH As Double = 1000 '波長

Dim oEntity As AcadEntity

Dim oLine As AcadLine

Dim oSpline As AcadSpline

'ﾕｰｻﾞｰ選択で線分取得

On Error Resume Next

Call ThisDrawing.Utility.GetEntity(oEntity, Empty, "正弦波の基準とする線分を選択")

On Error GoTo 0

If TypeName(oEntity) <> "IAcadLine" Then Exit Sub

Set oLine = oEntity

'ｽﾌﾟﾗｲﾝで正弦波作成

Set oSpline = CreateSinWave(oLine, AMPLITUDE, WAVELENGTH)

End Sub

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

'- 正弦波を作成する

'- oLine ：基準の線分

'- dAmplitude ：振幅

'- dWaveLength ：波長

'- 戻り値：作成した正弦波ｽﾌﾟﾗｲﾝ

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

Private Function CreateSinWave(ByVal oLine As AcadLine, _

ByVal dAmplitude As Double, _

ByVal dWaveLength As Double) As AcadSpline

Dim oSpline As AcadSpline

Dim dLength As Double

Dim lCntCtrlPt As Long

Dim dSplinePt() As Double

Dim dTangent(2) As Double

Dim vPtStart As Variant

Dim vPtEnd As Variant

Dim vPtFit As Variant

Dim vVecLine As Variant

Dim vVecNorm As Variant

Dim lInverse As Long

Dim i As Long

Dim j As Long

Dim lIdx As Long

'始終点座標を取得

vPtStart = oLine.StartPoint

vPtEnd = oLine.EndPoint

'線分方向ﾍﾞｸﾄﾙおよび線分の垂直方向ﾍﾞｸﾄﾙを取得

vVecLine = CalculateVectorDirection(vPtStart(0), vPtStart(1), vPtEnd(0), vPtEnd(1))

vVecNorm = CalculateRotateVector(vVecLine(0), vVecLine(1), 90)

'線分長さからｽﾌﾟﾗｲﾝのﾌｨｯﾄ点の数を取得 (※必ず奇数とする)

dLength = Sqr(vVecLine(0) * vVecLine(0) + vVecLine(1) * vVecLine(1))

lCntCtrlPt = dLength \ (dWaveLength / 4) + 1

If lCntCtrlPt Mod 2 = 0 Then

lCntCtrlPt = lCntCtrlPt - 1

End If

'ｽﾌﾟﾗｲﾝのﾌｨｯﾄ点の数に合わせて配列ｻｲｽﾞ変更

ReDim dSplinePt(lCntCtrlPt * 3 - 1)

'ｽﾌﾟﾗｲﾝのﾌｨｯﾄ点の数だけﾙｰﾌﾟ

For i = 0 To lCntCtrlPt - 1

If i = 0 Then

'初回ﾙｰﾌﾟは線分の始点座標を配列に格納

For j = 0 To 2

dSplinePt(lIdx) = vPtStart(j)

lIdx = lIdx + 1

Else

'偶数番目のﾌｨｯﾄ点は線分上

If i Mod 2 = 0 Then

lInverse = 0

'奇数番目のﾌｨｯﾄ点は上下を交互に切り替え

Else

If i Mod 4 = 1 Then

lInverse = 1

Else

lInverse = -1

End If

'i番目のﾌｨｯﾄ点の座標を計算で求める

vPtFit = CalculateEndPoint(vPtStart(0), vPtStart(1), vVecLine(0), vVecLine(1), dWaveLength / 4 * i) '波長方向

vPtFit = CalculateEndPoint(vPtFit(0), vPtFit(1), vVecNorm(0), vVecNorm(1), lInverse * dAmplitude) '振幅方向

'計算結果のﾌｨｯﾄ点座標を配列に格納

ReDim Preserve vPtFit(2)

For j = 0 To 2

dSplinePt(lIdx) = vPtFit(j)

lIdx = lIdx + 1

End If

'取得した座標値をもとにｽﾌﾟﾗｲﾝ作成

Set oSpline = ThisDrawing.ModelSpace.AddSpline(dSplinePt, dTangent, dTangent)

'描画更新

ThisDrawing.Regen acActiveViewport

Set CreateSinWave = oSpline

End Function

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

'- 始点座標と方向成分、長さから終点座標を計算する

'- dX ：始点X座標

'- dY ：始点Y座標

'- dDirX ：X方向成分

'- dDirY ：Y方向成分

'- dLength ：長さ

'- 戻り値：終点のXY座標が入った配列

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

Private Function CalculateEndPoint(ByVal dStartX As Double, ByVal dStartY As Double, _

ByVal dDirX As Double, ByVal dDirY As Double, _

ByVal dLength As Double) As Double()

Dim dCoordEnd(1) As Double

Dim dMagnitude As Double

Dim dVecUnitX As Double

Dim dVecUnitY As Double

Dim dEndX As Double

Dim dEndY As Double

'方向ﾍﾞｸﾄﾙの大きさを計算

dMagnitude = Sqr(dDirX * dDirX + dDirY * dDirY)

'単位ﾍﾞｸﾄﾙを計算

dVecUnitX = dDirX / dMagnitude

dVecUnitY = dDirY / dMagnitude

'終点の座標を計算

dEndX = dStartX + dVecUnitX * dLength

dEndY = dStartY + dVecUnitY * dLength

dCoordEnd(0) = dEndX

dCoordEnd(1) = dEndY

'結果を配列として返す

CalculateEndPoint = dCoordEnd

End Function

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

'- 始終点座標からﾍﾞｸﾄﾙ方向成分を計算する

'- dStartX ：始点X座標

'- dStartY ：始点Y座標

'- dEndX ：終点X座標

'- dEndY ：終点Y座標

'- (flgUnit) ：単位ﾍﾞｸﾄﾙ化ﾌﾗｸﾞ

'- 戻り値：ﾍﾞｸﾄﾙ方向成分が入った配列

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

Private Function CalculateVectorDirection(ByVal dStartX As Double, ByVal dStartY As Double, _

ByVal dEndX As Double, ByVal dEndY As Double, _

Optional flgUnit As Boolean = False) As Double()

Dim dVector(1) As Double

Dim dMagnitude As Double

Dim dVecX As Double

Dim dVecY As Double

'ﾍﾞｸﾄﾙ成分を計算

dVector(0) = dEndX - dStartX

dVector(1) = dEndY - dStartY

'単位ﾍﾞｸﾄﾙに変換

If flgUnit = True Then

dMagnitude = Sqr(dVector(0) * dVector(0) + dVector(1) * dVector(1))

dVector(0) = dVector(0) / dMagnitude

dVector(1) = dVector(1) / dMagnitude

End If

CalculateVectorDirection = dVector

End Function

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

'- ﾍﾞｸﾄﾙ方向成分と角度から回転したﾍﾞｸﾄﾙの方向成分を計算する

'- dVecX ：ﾍﾞｸﾄﾙX方向成分

'- dVecY ：ﾍﾞｸﾄﾙY方向成分

'- dAngle ：角度

'- 戻り値：回転後のﾍﾞｸﾄﾙ方向成分が入った配列

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

Private Function CalculateRotateVector(ByVal dVecX As Double, ByVal dVecY As Double, _

ByVal dAngle As Double) As Double()

Const PI As Double = 3.1415926535 '円周率

Dim dVector(1) As Double

Dim dRadian As Double

'角度をﾗｼﾞｱﾝに変換

dRadian = dAngle * (PI / 180)

'回転ﾍﾞｸﾄﾙを計算

dVector(0) = dVecX * Cos(dRadian) - dVecY * Sin(dRadian)

dVector(1) = dVecX * Sin(dRadian) + dVecY * Cos(dRadian)

CalculateRotateVector = dVector

End Function

コード解説　

ユーザー選択で線分取得

正弦波の作成基準の対象となる線分をユーザー選択で取得するためには、UtilityオブジェクトのGetEntityメソッドを利用します。GetEntityメソッドは実行されるとユーザーの選択待ち状態となり対話的にユーザーが選択したオブジェクトを取得することができます。


    'ﾕｰｻﾞｰ選択で線分取得
    On Error Resume Next
    Call ThisDrawing.Utility.GetEntity(oEntity, Empty, "正弦波の基準とする線分を選択")
    On Error GoTo 0
    If TypeName(oEntity) <> "IAcadLine" Then Exit Sub
    Set oLine = oEntity

'ﾕｰｻﾞｰ選択で線分取得

On Error Resume Next

Call ThisDrawing.Utility.GetEntity(oEntity, Empty, "正弦波の基準とする線分を選択")

On Error GoTo 0

If TypeName(oEntity) <> "IAcadLine" Then Exit Sub

Set oLine = oEntity

ユーザーが選択されたオブジェクトは第1引数の変数に、選択された座標は第2引数の変数にそれぞれ格納されます。第3引数はユーザー選択時に表示するメッセージで省略も可能です。GetEntityメソッドはユーザーが選択キャンセル([Esc]キーの押下)した場合にエラーが発生してしまうため、「On Error Resume Next」でエラーを無視する等の何らかの対策が必要になります。

サンプルコードでは変数「oEntity」にユーザーが選択されたオブジェクトが入るため、そのオブジェクトが線分であるかをTypeName関数を使って判定し、線分でなかったり選択されなかった場合(Nothingの場合)は処理を終了するようにしています。
　

正弦波作成

正弦波は振幅が0もしくは最大最小値となる点を通るようなスプラインで再現していますが、VBAでスプラインを作成する際にはこれらフィット点(■)の座標を格納した配列を用意する必要があります

振幅と波長は数値として入力されるため、線分の始終点座標および振幅と波長の値を使って計算することですべての点の座標を取得することができます。例えばスプラインの始点の次のフィット点の座標は、始点から線分方向に波長の1/4進めて、そこから線分の垂直方向に振幅分だけ進めた地点の座標値となります。下図を見れば始点を基準として各点の座標を求められることがわかります。

　
また、サンプルコードではスプラインの終点が線分上で終わるように調整をしていますがこれも重要な処理となっています。スプラインは各フィット点の位置関係とその連続性によって生成される曲線のため、構成点が1つ増えるだけでもスプライン全体の形状に影響が及ぼされます。このとき線分上でない点でスプラインを終わらせてしまうと下図のように少し歪な形状となってしまいます。