スプライン曲線で正弦波を作成するマクロ｜AutoCAD VBAマクロの作成方法
AutoCADできれいな波線を作図するのは少し面倒ですが、VBAを使うことで一瞬で作成することが可能になります。ここではVBAとスプライン曲線を使って正弦波を作成する方法を解説します。
マクロ機能
・作成する波形の波長と振幅はコード内で変更可能
・正弦波を作成する範囲は入力された線分の長さに収まるように自動調整する
・入力された線分は水平である必要なし (傾いていても作成可能)
「正弦波」と記載していますが、振幅が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
コード解説
ユーザー選択で線分取得
正弦波の作成基準の対象となる線分をユーザー選択で取得するためには、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
ユーザーが選択されたオブジェクトは第1引数の変数に、選択された座標は第2引数の変数にそれぞれ格納されます。第3引数はユーザー選択時に表示するメッセージで省略も可能です。GetEntityメソッドはユーザーが選択キャンセル([Esc]キーの押下)した場合にエラーが発生してしまうため、「On Error Resume Next」でエラーを無視する等の何らかの対策が必要になります。
サンプルコードでは変数「oEntity」にユーザーが選択されたオブジェクトが入るため、そのオブジェクトが線分であるかをTypeName関数を使って判定し、線分でなかったり選択されなかった場合(Nothingの場合)は処理を終了するようにしています。
正弦波作成
正弦波は振幅が0もしくは最大最小値となる点を通るようなスプラインで再現していますが、VBAでスプラインを作成する際にはこれらフィット点(■)の座標を格納した配列を用意する必要があります
振幅と波長は数値として入力されるため、線分の始終点座標および振幅と波長の値を使って計算することですべての点の座標を取得することができます。例えばスプラインの始点の次のフィット点の座標は、始点から線分方向に波長の1/4進めて、そこから線分の垂直方向に振幅分だけ進めた地点の座標値となります。下図を見れば始点を基準として各点の座標を求められることがわかります。
また、サンプルコードではスプラインの終点が線分上で終わるように調整をしていますがこれも重要な処理となっています。スプラインは各フィット点の位置関係とその連続性によって生成される曲線のため、構成点が1つ増えるだけでもスプライン全体の形状に影響が及ぼされます。このとき線分上でない点でスプラインを終わらせてしまうと下図のように少し歪な形状となってしまいます。
スプラインを作成するためのAddSplineメソッドでは始終点での接線連続とする方向の定義もできるため、上図のような終点の場合は線分方向の接線情報を付与すれば歪な形を解消することができます。サンプルコードではそこまで細かい処理はせず接線方向も特に設定していません。
まとめ
AutoCAD VBAで形状作成する際に座標を求める必要に駆られることはしばしばあり、こういった際に数学の知識が必須となってくるため、2D/3D空間の計算知識(ベクトル、外積/内積、回転行列、三角関数など)は身に着けておくことをお勧めします。
関連書籍
