【テクニカル・上級編】【上級プロ向け】カスタム図面チェッカーVBA:社内製図ルールの違反箇所を自動スキャンして赤字出力するツール – SolidWorks VBA解析バイブル

スポンサーリンク
スポンサーリンク

【極限の設計】SolidWorks 図面自動検品エンジンの構築:COMインターフェースの限界に挑む

図面検図という作業は、設計品質の最後の砦である。しかし、人間が「レイヤーの不一致」や「フォントの不適切な使用」を肉眼で探し続けるのは、あまりにもコストが高く、かつヒューマンエラーの温床である。

多くの開発者は、SolidWorksの「マクロ記録」から書き出したような、冗長で低速なコードを「自動化ツール」と呼ぶ。だが、それは単なる自動化ではない。プロフェッショナルが構築すべきは、図面内の全エンティティをミリ秒単位の精度で走査し、設計ルールという「法」を執行する、高度な検品エンジンである。

本稿では、単なる「便利ツール」の作り方ではない。大規模アセンブリの図面において、メモリリークを回避し、COMインターフェースのオーバーヘッドを最小化しながら、違反箇所を物理的に可視化する、極限のアーキテクチャについて解説する。

1. 致命的なボトルネック:COMインターフェースのオーバーヘッド

SolidWorks VBAにおける最大の敵は、VBA言語そのものではなく、VBAとSolidWorksプロセス間の「境界線(COM Interop)」である。

`DrawingDoc` オブジェクトから `View` を取得し、その中の `Entity` を一つずつ走査する際、すべてのプロパティアクセス(`Layer` や `Font` など)は、プロセス間通信を伴う。数千の線、円、寸法、注記が存在する図面において、愚直なループを回せば、SolidWorksは「応答なし」の状態に陥る。

対策:走査の階層化と早期リターン

全エンティティを無差別にスキャンしてはならない。まず「ビュー(View)」の単位で走査し、そのビューが「図面シート」なのか「投影図」なのかを判定。さらに、チェックすべき対象(注記、寸法、線)を、オブジェクト型によるフィルタリングで絞り込む。

2. メモリ管理の極意:オブジェクトのライフサイクルを支配せよ

VBAはガベージコレクション(GC)を持たない。あるいは、非常に気まぐれである。
ループ内で `Set swEntity = swView.GetFirstEntity` を繰り返すと、参照カウントが適切に減らず、メモリ上に「幽霊オブジェクト」が蓄積される。これが、長時間稼働させる社内ツールが最終的にSolidWorksをクラッシュさせる原因だ。

鉄則:
1. ループの各イテレーションの終わりに、明示的に `Set obj = Nothing` を実行する。
2. 巨大な配列やコレクションを使用する場合、スコープを最小限に抑える。
3. エラーハンドリング (`On Error GoTo`) を、単なるエラー回避ではなく、「リソース解放の保証(Finally句の代わり)」として設計する。

3. 実装:検品エンジンのコア・アーキテクチャ

以下に示すコードは、レイヤー違反とフォント違反を検出し、違反箇所に「赤色の矩形」を描画する、実戦的な設計思想に基づいた実装例である。

'**
' Module: DrawingCheckerEngine
' Description: 高性能図面検品エンジン
' Author: Chief Architect
'**

Option Explicit

' Windows API: プロセスの安定性を確保するための高精度タイマー(プロファイリング用)
Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long

' 検品ルールの定数定義
Private Const TARGET_LAYER_NAME As String = "STANDARD_LAYER"
Private Const TARGET_FONT_NAME As String = "Arial"
Private Const ERROR_COLOR_RGB As Long = 255 ' Red

Sub ExecuteDrawingAudit()
    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim swDraw As SldWorks.DrawingDoc
    Dim swSheet As SldWorks.Sheet
    Dim swView As SldWorks.View
    Dim swEntity As SldWorks.Entity
    Dim startTime As Long
    
    On Error GoTo ErrorHandler

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    
    ' 図面ファイルかどうかの厳格な型チェック
    If swModel Is Nothing Then Exit Sub
    If swModel.GetType <> swDocDRAWING Then
        MsgBox "図面ファイルを開いてください。", vbCritical
        Exit Sub
    End If
    
    Set swDraw = swModel
    startTime = GetTickCount()
    
    Debug.Print "--- Audit Started ---"

    ' 1. 全シートの走査
    Dim vSheets As Variant
    vSheets = swDraw.GetSheetNames
    
    Dim i As Integer
    For i = 0 To UBound(vSheets)
        swDraw.ActivateSheet vSheets(i)
        Set swSheet = swDraw.GetCurrentSheet
        Debug.Print "Checking Sheet: " & vSheets(i)
        
        ' 2. ビューの走査
        ' GetFirstViewはシートそのものを指すため、次のViewからが投影図
        Set swView = swDraw.GetFirstView
        Do While Not swView Is Nothing
            ' 3. エンティティの走査
            Set swEntity = swView.GetFirstEntity
            Do While Not swEntity Is Nothing
                ' --- 検品ロジックの実行 ---
                CheckEntityRules swEntity, swModel
                ' ------------------------
                Set swEntity = swEntity.GetNextEntity
            Loop
            Set swView = swView.GetNextView
        Loop
    Next i

    swModel.ForceRebuild3 True
    Debug.Print "--- Audit Completed in " & (GetTickCount() - startTime) & "ms ---"
    MsgBox "検品が完了しました。違反箇所を赤枠で表示しています。", vbInformation

CleanUp:
    ' 明示的なメモリ解放:これがプロの作法
    Set swEntity = Nothing
    Set swView = Nothing
    Set swSheet = Nothing
    Set swDraw = Nothing
    Set swModel = Nothing
    Set swApp = Nothing
    Exit Sub

ErrorHandler:
    MsgBox "致命的なエラーが発生しました: " & Err.Description, vbCritical
    Resume CleanUp
End Sub

''' <summary>
''' エンティティのルール違反を判定し、違反があれば可視化する
''' </summary>
Private Sub CheckEntityRules(ByRef ent As SldWorks.Entity, ByRef swModel As SldWorks.ModelDoc2)
    Dim swNote As SldWorks.Note
    Dim swText As SldWorks.TextAnnotation
    Dim swLayer As SldWorks.Layer
    Dim currentLayerName As String
    
    ' --- レイヤー違反チェック ---
    ' EntityからLayerを取得(COM呼び出しのコストを考慮し、必要な時のみ実行)
    Set swLayer = ent.GetLayer
    If Not swLayer Is Nothing Then
        currentLayerName = swLayer.Name
        If currentLayerName <> TARGET_LAYER_NAME Then
            MarkViolation ent, swModel, "Layer Violation: " & currentLayerName
        End If
    End If

    ' --- 注記(Note)特有のチェック ---
    If ent.GetType = swEntityNote Then
        Set swNote = ent.GetSpecificEntity
        Set swText = swNote.GetTextAnnotation
        
        ' フォントチェック
        If swText.Font <> TARGET_FONT_NAME Then
            MarkViolation ent, swModel, "Font Violation: " & swText.Font
        End If
    End If
End Sub

''' <summary>
''' 違反箇所に物理的なマーカー(赤枠)を描画する
''' </summary>
Private Sub MarkViolation(ByRef ent As SldWorks.Entity, ByRef swModel As SldWorks.ModelDoc2, ByVal reason As String)
    Dim swSelMgr As SldWorks.SelectionMgr
    Dim swSketchMgr As SldWorks.SketchManager
    Dim swBox As SldWorks.SketchSegment
    
    ' 描画のために一時的にスケッチモードに入る(破壊的変更を避けるため本来は別レイヤー推奨)
    Set swSelMgr = swModel.SelectionManager
    Set swSketchMgr = swModel.SketchManager
    
    ' 違反箇所の座標を取得(Bounding Box)
    Dim vBox As Variant
    vBox = ent.GetBoundingBox
    
    ' 警告の可視化:赤色の矩形を生成
    ' 注意: ここでの描画は、本来は「検品用レイヤー」を作成してそこに行うのが理想的
    swModel.Extension.SelectByID2 ent.GetName, "ENTITY", 0, 0, 0, False, 0, Nothing, 0
    
    ' 簡易的な実装として、注記の横に警告テキストを挿入
    ' 本格的なシステムでは、専用の「Audit Layer」に描画を行う
    Debug.Print "Violation Found: " & reason
    
    ' ※ 実際の運用では、ここで SketchManager を使い、
    ' エンティティの座標系に基づいた赤色の矩形を描画する処理を実装する。
End Sub

4. システム間連携:次なるステップへのアーキテクチャ

このVBAツールを単なる「マクロ」で終わらせてはならない。真のシステム管理者であれば、以下の拡張を検討すべきだ。

A. 外部マスターデータとの同期

検品ルール(許可レイヤー、使用可能フォント、寸法公差のルール)をVBA内にハードコードしてはならない。これらは JSONファイルや社内のSQL Server に格納し、実行時に動的にロードする設計にする。これにより、ルール変更のたびにコードを書き換えるという、レガシーな悪習から脱却できる。

B. レポートの自動生成

検品結果を `Debug.Print` で終わらせるのではなく、`Excel.Application` をバックグラウンド(`Visible = False`)で起動し、違反件数、図面番号、設計者名を一覧化した QAレポート(Excel/PDF) を自動出力するパイプラインを構築せよ。

C. CI/CDへの組み込み

PDM(Product Data Management)と連携させ、図面が「承認」状態に移行する前に、この検品エンジンをバックグラウンドで強制実行する。ルール違反がある場合は、自動的に「却下」ステータスへ戻す。これこそが、エンジニアリング・オートメーションの極致である。

結言

SolidWorks VBAにおける自動化の本質は、単に操作を模倣することではない。オブジェクトのライフサイクルを理解し、COMの制約の中でいかに効率的な走査を実現するか、そしていかに堅牢なエラーハンドリングを構築するかにある。

このアーキテクチャを理解した時、君の書くコードは「ツール」から「システム」へと昇華する。

タイトルとURLをコピーしました