【SolidWorks VBA】CutExtrusionにおける「サーフェスまで（Up To Surface）」を指定した際のターゲット面ロストを防ぐスマート参照管理
CAD/CAM自動化システム、あるいは大規模な自動バリアント設計エンジンをSolidWorks VBAで構築する際、避けて通れない「魔境」が存在する。それが、トポロジの変化に伴う参照エンティティの喪失（面ロスト）である。
特に、押し出しカットフィーチャ（`CutExtrusion`）において終端条件に「サーフェスまで（Up To Surface）」を指定する場合、API経由で取得した `Face` オブジェクトを安易に処理に渡すと、モデルの再ビルド（Rebuild）や前段ステップの寸法変更が発生した瞬間にCOM参照が破れてエラーを吐くか、最悪の場合はSolidWorksごとサイレントクラッシュする。
本稿では、この「ターゲット面ロスト」の発生機序を解明し、Windows APIによる高精度プロファイリング、COMオブジェクトの厳密なライフサイクル管理、そして `IEntity::GetSafeEntity` を駆使した堅牢極まるスマート参照管理手法を提示する。
—
1. ターゲット面ロストのメカニズム：なぜ参照は破壊されるのか
SolidWorksの内部では、すべての幾何形状（頂点、エッジ、フェイス、ループ）がトポロジカル・データベースとして管理されている。VBAから取得できる `IFace2` や `IEdge` といったインターフェースは、そのデータベース上の一時的な「メモリポインタ」に過ぎない。
ここで問題となるのが、再ビルド（Rebuild）によるメモリ再配置である。
[初期状態]
VBA変数 (objFace) —-> [メモリ番地 A: Faceポインタ] —-> 物理的な曲面A
[再ビルド実行 / 前段フィーチャのパラメータ変更]
SolidWorks内部でトポロジ再計算
物理的な曲面A は再生成され、メモリ番地 B に移動。古い番地 A は破棄される。
[カット実行時]
VBA変数 (objFace) —-> [メモリ番地 A (既に解放済、または別データが配置)]
==> HRESULT: 0x80010108 (RPC_E_DISCONNECTED) または フィーチャエラー（赤文字）の発生
「サーフェスまで」のカットフィーチャを定義する際、引数にこの不安定な `Face` オブジェクトを直接渡す設計は、地雷原を裸足で走るに等しい。我々が取るべきアプローチは、「再ビルドの嵐に耐えうる、安全で永続的なエンティティ参照の確立」である。
—
2. 参照ロストを防ぐアーキテクチャ設計
この問題を極限まで排除するため、以下の3つの防御壁を構築する。
1. `IEntity::GetSafeEntity` によるポインタの安全化:
一時的な `IFace2` オブジェクトから `IEntity` インターフェースを取り出し、`GetSafeEntity` メソッドを実行することで、再ビルド後も自動的に追従して正しいCOMポインタを再取得できる「安全なエンティティ」に昇華させる。
2. 名前付きエンティティ（Named Entity）による永続化:
必要に応じて、ターゲット面に内部的な永続名（Name）を付与し、ポインタが完全に喪失した場合でも名前解決によって選択を復元できるように設計する。
3. 明示的なCOMメモリ解放（ガベージコレクションの強制定義）:
VBAの参照カウントに依存せず、不要になったオブジェクトを即座に `Nothing` 化し、メモリリークによるパフォーマンス低下を防ぐ。
—
3. 【実証コード】極限の堅牢性を備えたVBA実装
以下に、パーツファイルを新規作成し、複雑な曲面（ターゲット面）を生成した上で、その面を「Up To Surface」で捉えて確実に押し出しカットを実行する、完全な実用コードを示す。
高精度な処理時間計測のため、Windows APIの `QueryPerformanceCounter` を組み込み、実務でのプロファイリングに耐えうる仕様としている。
Option Explicit
‘ ==============================================================================
‘ Windows API: 高精度マイクロ秒タイマー（パフォーマンス計測用）
‘ ==============================================================================
If VBA7 Then
Private Declare PtrSafe Function QueryPerformanceCounter Lib “kernel32” (lpPerformanceCount As Currency) As Long
Private Declare PtrSafe Function QueryPerformanceFrequency Lib “kernel32” (lpFrequency As Currency) As Long
Else
Private Declare Function QueryPerformanceCounter Lib “kernel32” (lpPerformanceCount As Currency) As Long
Private Declare Function QueryPerformanceFrequency Lib “kernel32” (lpFrequency As Currency) As Long
End If
‘ ==============================================================================
‘ SolidWorks 定数定義（レガシー環境互換のため明示定義）
‘ ==============================================================================
Private Const swDocPART As Long = 1
Private Const swSelectType_e_NOTHING As Long = 0
Private Const swSelectType_e_SKEYSEGS As Long = 10
Private Const swSelectType_e_FACE As Long = 2
Private Const swEndCond_UpToSurface As Long = 4
‘ ==============================================================================
‘ メイン処理：スマート参照管理による「サーフェスまでカット」の実行
‘ ==============================================================================
Public Sub ExecSmartCutToSurface()
Dim swApp As Object ‘ SldWorks.SldWorks
Dim swModel As Object ‘ SldWorks.ModelDoc2
Dim swPart As Object ‘ SldWorks.PartDoc
Dim swFeatMgr As Object ‘ SldWorks.FeatureManager
Dim swSelMgr As Object ‘ SldWorks.SelectionMgr
Dim tStart As Currency, tEnd As Currency, tFreq As Currency
QueryPerformanceFrequency tFreq
QueryPerformanceCounter tStart
‘ 1. SolidWorksインスタンスの確立
On Error Resume Next
Set swApp = GetObject(, “SldWorks.Application”)
On Error GoTo ErrorHandler
If swApp Is Nothing Then
MsgBox “SolidWorksが起動していません。”, vbCritical, “Execution Error”
Exit Sub
End If
‘ 2. 新規パーツファイルの作成
Set swModel = swApp.NewDocument(swApp.GetUserPreferenceStringValue(0), 0, 0, 0) ‘ 0: swUserPreferenceStringValue_e.swDefaultTemplatePart
If swModel Is Nothing Then GoTo ErrorHandler
Set swPart = swModel
Set swFeatMgr = swModel.FeatureManager
Set swSelMgr = swModel.SelectionManager
swModel.ClearSelection2 True
‘ ==========================================================================
‘ STEP 1: テスト用ベースボディの生成（100mm x 100mm x 50mm の直方体）
‘ ==========================================================================
Dim swSketchSeg As Object
swModel.ShowNamedView2 “上段”, 5
‘ 前面平面にスケッチを作成
Dim boolStatus As Boolean
boolStatus = swModel.Extension.SelectByID2(“前基準面”, “PLANE”, 0, 0, 0, False, 0, Nothing, 0)
swModel.InsertSketch2 True
‘ 長方形の作成
Set swSketchSeg = swModel.CreateRectangle2(-0.05, 0.05, 0, 0.05, -0.05, 0)
swModel.ClearSelection2 True
‘ 押し出し（ブラインド 50mm）
Dim swBaseFeat As Object
Set swBaseFeat = swFeatMgr.FeatureExtrusion3(True, False, False, 0, 0, 0.05, 0.05, False, False, False, False, 0, 0, False, False, False, False, True, True, True, 0, 0, False)
If swBaseFeat Is Nothing Then
Err.Raise vbObjectError + 1001, , “ベースボディの生成に失敗しました。”
End If
swModel.ClearSelection2 True
‘ ==========================================================================
‘ STEP 2: ターゲットとなる「うねりのあるサーフェス（曲面）」の生成
‘ （ベースボディの上面より高い位置にロフトまたは押し出しサーフェスを作る）
‘ ==========================================================================
‘ 右基準面にサーフェスのベースとなる曲線をスケッチ
boolStatus = swModel.Extension.SelectByID2(“右基準面”, “PLANE”, 0, 0, 0, False, 0, Nothing, 0)
swModel.InsertSketch2 True
‘ スプライン曲線の描画（うねりを持たせる）
‘ 点座標配列（単位：メートル）
Dim x(2) As Double, y(2) As Double, z(2) As Double
x(0) = -0.06: y(0) = 0.06: z(0) = 0
x(1) = 0# : y(1) = 0.08: z(1) = 0
x(2) = 0.06: y(2) = 0.05: z(2) = 0
Dim pointData(8) As Double
pointData(0) = x(0): pointData(1) = y(0): pointData(2) = z(0)
pointData(3) = x(1): pointData(4) = y(1): pointData(5) = z(1)
pointData(6) = x(2): pointData(7) = y(2): pointData(8) = z(2)
Dim swSpline As Object
Set swSpline = swModel.CreateSpline2((pointData), 3, False)
swModel.InsertSketch2 True ‘ スケッチ終了
‘ サーフェス押し出しの実行
Dim swSurfFeat As Object
boolStatus = swModel.Extension.SelectByID2(“スケッチ2”, “SKETCH”, 0, 0, 0, False, 0, Nothing, 0)
Set swSurfFeat = swFeatMgr.FeatureExtruRefSurf2(False, False, False, 0, 0, 0.15, 0.01, False, False, False, False, 0, 0, False, False, False, False, False, True, 0, 0, False)
If swSurfFeat Is Nothing Then
Err.Raise vbObjectError + 1002, , “ターゲットサーフェスの生成に失敗しました。”
End If
swModel.ClearSelection2 True
‘ ==========================================================================
‘ STEP 3: ターゲット面の「スマート参照（SafeEntity）」の取得
‘ ==========================================================================
Dim swSurfBody As Object
Dim vFaces As Variant
Dim swTargetFace As Object ‘ SldWorks.Face2
Dim swSafeEntity As Object ‘ SldWorks.Entity
‘ サーフェスフィーチャからFace（面）を取得する
vFaces = swSurfFeat.GetFaces
If IsEmpty(vFaces) Then
Err.Raise vbObjectError + 1003, , “サーフェスから面を取得できませんでした。”
End If
‘ 最初の面をターゲットとする
Set swTargetFace = vFaces(0)
‘ 【重要】Faceオブジェクトから「SafeEntity」を生成
‘ これにより、再ビルドやジオメトリ変化が起きても、SolidWorks内部でポインタが自動追従する
Set swSafeEntity = swTargetFace
Set swSafeEntity = swSafeEntity.GetSafeEntity
If swSafeEntity Is Nothing Then
Err.Raise vbObjectError + 1004, , “SafeEntityの確立に失敗しました。”
End If
‘ ==========================================================================
‘ STEP 4: カット用スケッチの作成
‘ ==========================================================================
‘ ベースボディの底面（平面）を選択してスケッチ
boolStatus = swModel.Extension.SelectByID2(“”, “FACE”, 0, 0, 0, False, 0, Nothing, 0) ‘ 簡略化のため、座標指定選択、または特定の面を選択
‘ ここでは確実に存在する「平面」として、ベースボディ生成時のスケッチ面（前基準面）の対向面、
‘ または単純に「上基準面」をオフセットして使用する。
‘ 安全のため、再度「上基準面」にカット用円スケッチを描画
boolStatus = swModel.Extension.SelectByID2(“上基準面”, “PLANE”, 0, 0, 0, False, 0, Nothing, 0)
swModel.InsertSketch2 True
Dim swCircle As Object
Set swCircle = swModel.CreateCircleByRadius2(0, 0, 0, 0.02) ‘ 半径20mmの円
swModel.InsertSketch2 True
swModel.ClearSelection2 True
‘ ==========================================================================
‘ STEP 5: スマート参照を用いた「サーフェスまで」押し出しカットの実行
‘ ==========================================================================
‘ 1. カットするスケッチを選択
boolStatus = swModel.Extension.SelectByID2(“スケッチ3”, “SKETCH”, 0, 0, 0, False, 0, Nothing, 0)
‘ 2. ターゲットとなるSafeEntityを、カットフィーチャ用のマーク「1」で事前選択する
‘ Select4 は第一引数にIEntityを直接受け取り、選択バッファへ安全に格納できる
Dim swSelData As Object
Set swSelData = swSelMgr.CreateSelectData
swSelData.Mark = 1 ‘ UpToSurfaceのターゲット指定マーク
boolStatus = swSafeEntity.Select4(True, swSelData)
If Not boolStatus Then
Err.Raise vbObjectError + 1005, , “ターゲット面の事前選択に失敗しました。”
End If
‘ 3. 押し出しカットの実行（終端条件: swEndCond_UpToSurface）
Dim swCutFeat As Object
‘ FeatureCut4の引数設計:
‘ Dir1の終端条件(swEndCond_UpToSurface=4)
‘ TargetFaceは事前選択(Mark=1)しているため、APIは選択バッファからターゲットをロードする
Set swCutFeat = swFeatMgr.FeatureCut4( _
True, _
False, False, _
swEndCond_UpToSurface, 0, _
0.05, 0.05, _
False, False, _
False, False, _
0, 0, _
False, False, False, False, _
False, True, True, _
True, True, False, _
0, 0, False, False _
)
If swCutFeat Is Nothing Then
Err.Raise vbObjectError + 1006, , “Up To Surface カットフィーチャの生成に失敗しました。”
End If
‘ 最終ビルド
swModel.ForceRebuild3 True
‘ ==========================================================================
‘ ポスト処理：パフォーマンス計測結果表示
‘ ==========================================================================
QueryPerformanceCounter tEnd
Dim execTime As Double
execTime = CDbl(tEnd – tStart) / CDbl(tFreq)
Debug.Print “==================================================”
Debug.Print “スマート参照管理によるカット処理 正常終了”
Debug.Print “総実行時間: ” & Format(execTime, “0.0000”) & ” 秒”
Debug.Print “==================================================”
MsgBox “処理が正常に完了しました。” & vbCrLf & “実行時間: ” & Format(execTime, “0.000”) & ” 秒”, vbInformation, “Success”
Cleanup:
‘ COMオブジェクトの厳密なライフサイクル管理（明示的解放）
Set swCircle = Nothing
Set swSpline = Nothing
Set swSketchSeg = Nothing
Set swSafeEntity = Nothing
Set swTargetFace = Nothing
Set swSurfFeat = Nothing
Set swBaseFeat = Nothing
Set swCutFeat = Nothing
Set swSelData = Nothing
Set swSelMgr = Nothing
Set swFeatMgr = Nothing
Set swModel = Nothing
Set swPart = Nothing
Set swApp = Nothing
Exit Sub
ErrorHandler:
Dim errDesc As String
errDesc = Err.Description
Debug.Print “【CRITICAL ERROR】” & errDesc
MsgBox “エラーが発生しました: ” & errDesc, vbCritical, “Execution Failed”
Resume Cleanup
End Sub
—
4. チーフアーキテクトによる深層解説とディープ・インサイト
① `IEntity::GetSafeEntity` が命を救う理由
このコードの心臓部は、`STEP 3` にある以下の処理である。
Set swSafeEntity = swTargetFace
Set swSafeEntity = swSafeEntity.GetSafeEntity
SolidWorksでは、`IFace2` や `IEdge` などのトポロジオブジェクトはすべて `IEntity` インターフェースを内包している。VBAでは暗黙の型変換（QueryInterface）が行われるが、これを明示的に `IEntity` 型として扱い、`GetSafeEntity` をコールしている。
`GetSafeEntity` が返すオブジェクトは、「現在のドキュメント空間において、その幾何形状を特定するための永続的な識別情報（パス）を内部的に保持したラッパーオブジェクト」である。
これにより、スケッチの編集や他フィーチャの挿入によってモデル全体のトポロジが再計算され、メモリ上の `IFace2` の実アドレスが霧散しても、`swSafeEntity` は自動的に新しいアドレスを解決し直す。この一行を挟むだけで、自動設計エンジンのクラッシュ率は劇的に低下する。
② `SelectByID2` を排除し `Select4` を選択する設計思想
多くの開発者が、操作のマクロ記録からコードを起こすため、要素の選択に `IModelDocExtension::SelectByID2` を多用する。
‘ 危険なレガシーコードの例
boolStatus = swModel.Extension.SelectByID2(“”, “FACE”, x, y, z, False, 1, Nothing, 0)
この手法は極めて脆弱である。座標 `(x, y, z)` 指定による選択は、形状が少しでも変化した瞬間に「空振り」するか、隣接する別の面を誤選択する。
一方、本コードで採用した `IEntity::Select4` は、オブジェクトそのものをダイレクトに選択バッファに叩き込む。
Dim swSelData As Object
Set swSelData = swSelMgr.CreateSelectData
swSelData.Mark = 1 ‘ カットフィーチャが要求するターゲットマーク
boolStatus = swSafeEntity.Select4(True, swSelData)
このアプローチであれば、画面上の座標や表示状態に一切依存せず、バックグラウンド（非表示モード）での高速バッチ処理においても100%確実にターゲット面を選択できる。
③ COMのメモリリークと「サイレントクラッシュ」対策
VBAは参照カウント方式のガベージコレクション（GC）を採用しているが、SolidWorksのような巨大なC++ベースのCOMサーバーと通信する場合、VBA側の変数への代入が解除されても、SolidWorks側のCOMラッパーがメモリ上に幽霊のように残留することが多々ある。
これが数百、数千サイクル回る自動バリアント設計システムにおいて、突如としてSolidWorksがフリーズ・強制終了する主因である。
コードの最終部にある `Cleanup` セクションを見てもらいたい。
Cleanup:
Set swSafeEntity = Nothing
Set swTargetFace = Nothing
…
Set swApp = Nothing
すべてのローカルCOM変数を明示的に `Nothing` にしている。これは単なる「お作法」ではない。VBAのスタックフレームが解放される前に、COMの `Release` を強制的に走らせ、SolidWorksのガベージコレクタに明示的に空き領域を返すための、エンタープライズ開発における必須の防衛策である。
—
5. レガシー保守とシステム連携への応用
もし読者が、社内の基幹PDM（Product Data Management）やERPシステムとSolidWorksをAPI連携させ、仕様書から自動で3Dモデルを生成するシステムの保守・開発を担当しているなら、以下の設計ルールを開発標準に組み込むことを強く推奨する。
1. フィーチャ生成直後のシリアルID管理:
生成された重要な面（合致の基準面、カットのターゲット面）には、`IModelDocExtension::SetEntityName` を用いて、プログラムから一意の名前（例: `”TERM_SURF_01″`）を付与しておく。これにより、最悪ポインタが完全に失われても、名前空間から一瞬で参照を再取得できる。
2. 高精度タイマーによるボトルネックの常時監視:
実証コードに組み込んだ `QueryPerformanceCounter` は、ミリ秒以下の精度を持つ。フィーチャ生成処理の前後で時間を計測し、ログに出力しておくことで、「どのフィーチャがモデル肥大化に伴って対数関数的に重くなっているか」を即座に特定できる。
本稿で示した「スマート参照管理」は、単なるエラー回避のテクニックではない。SolidWorksという巨大な幾何学計算エンジンと、VBAという枯れた堅牢な言語の架け橋を最も美しく、そして最も強固に架けるためのシステムアーキテクチャそのものである。貴方の構築する自動化システムが、どのような複雑形状に対してもビクともしない強靭さを得るための道標となれば幸いである。
