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

SolidWorks VBA

2026.10.30

凡庸なスクリプトを卒業せよ：堅牢な「図面自動検図システム」を設計するためのアーキテクチャ論

凡庸なスクリプトを卒業せよ：堅牢な「図面自動検図システム」を設計するためのアーキテクチャ論

設計現場において、「図面の検図」は最もコストが高く、かつヒューマンエラーが混入しやすいプロセスだ。レイヤーの指定ミス、フォントの不一致、寸法指示の漏れ――これらを「人間の目」に頼っているうちは、組織の設計品質は一定の天井を超えることはない。

多くのエンジニアが「図面をスキャンしてエラーを見つけるVBA」を作ろうとして失敗する。その原因は、APIの使い方が下手なのではない。「オブジェクトのライフサイクル」と「責務の分離」という、ソフトウェア設計の本質を理解していないからだ。

本稿では、単なる「動くコード」ではなく、実務の現場で数千枚の図面を処理しても壊れない、プロフェッショナルな「カスタム図面チェッカー」の設計思想と実装方法を伝授する。

1. なぜあなたのチェッカーは「重い」のか？ ―― 致命的なアンチパターン

初心者が書くチェッカーは、往々にして以下のような構造になる。

1. 図面を開く。
2. 全シートをループする。
3. 全ビューをループする。
4. 全エンティティをループし、その中で `SelectByID2` を多用して属性をチェックする。
5. エラーがあれば、その場で赤字のテキストを書き込む。

これは設計として「破綻」している。

致命的な欠陥：

SelectionManagerへの過度な依存: `SelectByID2` は非常に重い処理だ。数千のエンティティに対してこれを行うと、SolidWorksは応答なし（Not Responding）に陥る。
密結合（Tight Coupling）: 「検知ロジック」と「描画ロジック」が混ざっている。もし「赤字で書き込むのではなく、Excelにレポートを出したい」と言われた瞬間、コードの全書き直しが必要になる。
エラーハンドリングの欠如: 図面内に「壊れたエンティティ」や「特殊な注釈」が一つでもあると、VBAはランタイムエラーで即死する。

2. プロフェッショナルが採用する「3レイヤー設計」

堅牢なシステムを構築するには、機能を以下の3つのレイヤーに分離して設計すべきである。

1. Scanner Layer (走査層): 図面の階層構造（Sheet $\rightarrow$ View $\rightarrow$ Entity）を、一切の副作用（Selectionの変更など）なしに、高速にトラバース（走査）する。
2. Rule Engine (判定層): Scannerから渡されたエンティティに対し、「これはルールに違反しているか？」という真偽値（Boolean）を返す。ここには「レイヤーチェック」「フォントチェック」「寸法欠落チェック」などの独立したロジックを配置する。
3. Reporter Layer (報告層): 判定結果を受け取り、図面上に描画するか、あるいはログファイルへ書き出すかを選択する。

この設計により、「ルールの追加」や「出力形式の変更」が、既存のコードを壊すことなく可能になる。

3. 実装例：堅牢なチェッカーのプロトタイプ

以下に、この設計思想に基づいたプロダクションレベルのコード構造を示す。

' ==============================================================================
' Module: DrawingCheckerCore
' Description: プロフェッショナル仕様の図面検図エンジンの骨格
' ==============================================================================

Option Explicit

' エラーの種類を定義するための列挙型
Public Enum CheckResultStatus
    Status_Pass = 0
    Status_LayerViolation = 1
    Status_FontViolation = 2
    Status_MissingDimension = 3
End Enum

' 判定結果を保持する構造体
Private Type InspectionResult
    Entity As Object
    Status As CheckResultStatus
    Message As String
End Type

''' <summary>
''' メインエントリーポイント
''' </summary>
Public Sub ExecuteDrawingAudit()
    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim swDraw As SldWorks.DrawingDoc
    
    On Error GoTo ErrorHandler
    
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    
    ' 1. 文脈の検証
    If swModel Is Nothing Then Exit Sub
    If swModel.GetType <> swDocDRAWING Then
        MsgBox "図面ファイルを開いた状態で実行してください。", vbCritical
        Exit Sub
    End If
    
    Set swDraw = swModel
    
    ' 高速化のための設定（画面更新の停止）
    swApp.UserControl = False ' UI制御を解放し、バックグラウンド処理を優先
    
    ' 2. 走査プロセスの開始
    Debug.Print "--- Audit Started: " & swModel.GetTitle & " ---"
    Call TraverseSheets(swDraw, swModel)
    Debug.Print "--- Audit Completed ---"

CleanUp:
    swApp.UserControl = True
    Exit Sub

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

''' <summary>
''' シート階層を走査する
''' </summary>
Private Sub TraverseSheets(swDraw As SldWorks.DrawingDoc, swModel As SldWorks.ModelDoc2)
    Dim vSheetNames As Variant
    Dim i As Integer
    Dim swSheet As SldWorks.Sheet
    Dim swView As SldWorks.View
    
    vSheetNames = swDraw.GetSheetNames
    
    For i = 0 To UBound(vSheetNames)
        swDraw.ActivateSheet vSheetNames(i)
        Set swSheet = swDraw.GetCurrentSheet
        
        ' ビューの走査（Sheet直下のビューから順に）
        Set swView = swDraw.GetFirstView ' Sheet自体が最初のビューとして返る
        
        Do While Not swView Is Nothing
            ' ビュー内のエンティティを走査
            Call InspectView(swView, swModel)
            Set swView = swView.GetNextView
        Loop
    Next i
End Sub

''' <summary>
''' ビュー内のエンティティを走査し、ルールエンジンに投げる
''' </summary>
Private Sub InspectView(swView As SldWorks.View, swModel As SldWorks.ModelDoc2)
    Dim swDisp As SldWorks.DisplayDimension
    Dim swNote As SldWorks.Note
    Dim vEntities As Variant
    Dim swEnt As SldWorks.Entity
    Dim i As Integer
    Dim res As InspectionResult

    ' --- A. 寸法(Dimension)のチェック ---
    Set swDisp = swView.GetFirstDisplayDimension
    Do While Not swDisp Is Nothing
        ' ルールエンジン呼び出し
        res = ValidateDimension(swDisp)
        If res.Status <> Status_Pass Then
            Call ReportError(swModel, res)
        End If
        Set swDisp = swDisp.GetNextDisplayDimension
    Loop

    ' --- B. 注釈(Note)のチェック ---
    Set swNote = swView.GetFirstNote
    Do While Not swNote Is Nothing
        res = ValidateNote(swNote)
        If res.Status <> Status_Pass Then
            Call ReportError(swModel, res)
        End If
        Set swNote = swNote.GetNextNote
    Loop
End Sub

' ==============================================================================
' Rule Engine Layer (判定ロジックをここに分離)
' ==============================================================================

Private Function ValidateDimension(swDisp As SldWorks.DisplayDimension) As InspectionResult
    Dim res As InspectionResult
    Set res.Entity = swDisp
    res.Status = Status_Pass
    
    ' 例: 特定のレイヤー以外を使用していないか
    Dim swDim As SldWorks.Dimension
    Set swDim = swDisp.GetDimension
    ' (ここにレイヤー判定ロジックを記述)
    
    ValidateDimension = res
End Function

Private Function ValidateNote(swNote As SldWorks.Note) As InspectionResult
    Dim res As InspectionResult
    Set res.Entity = swNote
    res.Status = Status_Pass
    
    ' 例: フォントが規定（Arial等）に沿っているか
    Dim swText As SldWorks.TextAnnotation
    Set swText = swNote
    
    If swText.FontName <> "Arial" Then
        res.Status = Status_FontViolation
        res.Message = "Font Mismatch: Expected Arial"
    End If
    
    ValidateNote = res
End Function

' ==============================================================================
' Reporter Layer (出力形式をここに分離)
' ==============================================================================

Private Sub ReportError(swModel As SldWorks.ModelDoc2, res As InspectionResult)
    ' 本来はここに「図面への描画」や「ログ出力」を記述する
    ' ここではデバッグ出力と、図面上への簡易的な赤字テキスト作成の例を示す
    
    Debug.Print "ERROR: " & res.Message
    
    ' 図面上に指摘事項を書き込む（プロダクションでは、描画の重みを考慮し、
    ' 最後にまとめて描画するか、メモリ上のリストに保持するのが定石）
    ' ここでは簡略化のため、直接描画を行う。
    
    ' ※ 実際には Entity の座標を取得して Note を作成する処理を行う
End Sub

4. アーキテクトの視点：実運用に向けたアドバイス

このコードをベースに、実用的な「製品」へと昇華させるために必要な、極めて重要な知見を共有する。

① データベースとの連携（ルールの外部化）

ハードコードされたルール（`If swText.FontName <> “Arial”` など）は、仕様変更に極めて弱い。
プロフェッショナルなツールでは、ルールを CSV または SQLite データベース に持たせるべきだ。

`RuleID | TargetType | Attribute | ExpectedValue | Severity`
`R001 | Note | FontName | Arial | Critical`

VBA側は起動時にこの定義ファイルを読み込み、判定エンジンに注入する。これにより、プログラマーではない設計管理者が、Excelを編集するだけで検図ルールを更新できる「運用可能なシステム」へと進化する。

② パフォーマンスの限界に挑む

図面が巨大（数千の部品、数百のビュー）な場合、`swModel.GraphicsRedraw2` を頻繁に呼び出すと処理が絶望的に遅くなる。

描画のバッチ処理: エラー箇所を即座に図面に描画するのではなく、`Collection` オブジェクトに「エラー情報」をすべて格納しておき、走査が完全に終わった後に一括で描画を行うこと。

③ 座標系の誤解を解く

図面上のエンティティの座標を取得する際、`GetTextPosition` や `GetBoundingBox` で得られる値が、「シート座標系」なのか「ビュー座標系」なのか「モデル座標系」なのかを常に意識せよ。これを間違えると、指摘の赤字が全く違う場所に表示されるという、ユーザーの信頼を失う致命的なバグに直結する。

結論

優れた自動化ツールとは、単に「作業を代行するもの」ではない。「設計標準（Standard）をコードとして定義し、それを強制する仕組み」である。

今回示したような、階層構造に基づいた分離設計、外部定義によるルールの柔軟性、そしてパフォーマンスへの配慮。これらを意識してコードを書くこと。それが、スクリプト・キディ（単なる書き手）と、エンジニアリング・アーキテクト（設計者）を分かつ境界線だ。