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

SolidWorks VBA

2026.10.30

マクロ記録を卒業せよ。SolidWorks VBAで構築する「自動図面検図システム」の極意

マクロ記録を卒業せよ。SolidWorks VBAで構築する「自動図面検図システム」の極意

こんにちは。設計自動化の世界へようこそ。

「マクロの記録」ボタンを押して、自分の操作をコードに書き出してみた。そんな経験はありませんか？それは素晴らしい第一歩です。しかし、もしあなたが「もっと複雑な判定をさせたい」「図面全体をスキャンして、ルール違反を自動で見つけたい」と考えているなら、その「記録」という魔法の杖を一度置いて、API（Application Programming Interface）の構造という真理に向き合う時が来たのかもしれません。

今日は、単なる操作の自動化を超えた、「カスタム図面チェッカー」の構築という、エンジニアにとって最高にエキサイティングなテーマに挑みます。

社内の製図ルール（レイヤー指定、フォント、寸法漏れなど）をVBAで判定し、違反箇所に「赤い警告」を自動で描画する。この仕組みを理解すれば、あなたのVBAスキルは「記録レベル」から「システム開発レベル」へと一気に跳ね上がります。

さあ、一緒に深淵を覗いてみましょう。

1. 脳内に「オブジェクトの地図」を描く

プログラミング、特にSolidWorks APIにおいて最も重要なのは、コードを書く前に「オブジェクトの階層構造（Hierarchy）」を完全にイメージすることです。

図面（Drawing）をチェックする場合、プログラムは「上から下へ」と降りていく必要があります。

1. DrawingDoc (図面全体)

Sheet (シート)
View (投影図/シートビュー)
Annotation (寸法、注釈、中心線など)
属性 (レイヤー名、フォント、座標など)

初心者が陥る最大の罠は、「図面全体に寸法がある」と思い込んでしまうことです。実際には、寸法は「特定のView（投影図）」の中に属しています。この階層を一段ずつ丁寧に辿っていく（＝走査する）ことこそが、チェッカー構築の核心です。

2. 実践：図面スキャン・アルゴリズムの設計

では、具体的にどのようにコードを組み立てるべきか。
今回のミッションは、「指定したレイヤーではない注釈（Annotation）を見つけたら、その場所に赤い文字で警告を出す」というものです。

【戦略的コード構造】

' --- 核心となるロジックの概念図 ---
' 1. 図面を開く
' 2. 全てのシートをループする
' 3. 各シート内の全てのビューをループする
' 4. 各ビュー内の全ての注釈（Annotation）をループする
' 5. 注釈のプロパティ（レイヤー等）をチェック
' 6. NGなら、その座標に「赤い注釈」を新規作成する

3. 【魂のコード】カスタム図面チェッカーの実装例

ここからは、実際に動くコードを見ていきましょう。
あえて「完璧すぎるコード」ではなく、「何をやっているかが手に取るようにわかる、拡張性の高いコード」を書きました。

Option Explicit

' =================================================================
' Custom Drawing Checker
' 目的: レイヤー違反の注釈を検出し、赤字で警告を描画する
' =================================================================
Sub Main()
    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 swAnn As SldWorks.Annotation
    
    ' ターゲットとする正しいレイヤー名
    Const CORRECT_LAYER As String = "Standard_Annotation"
    ' 警告メッセージ
    Const WARNING_TEXT As String = "【RULE VIOLATION: WRONG LAYER】"

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc

    ' 図面ファイルが開かれているかチェック
    If swModel Is Nothing Or swModel.GetType <> swDocDRAWING Then
        MsgBox "図面ファイルを開いた状態で実行してください。", vbCritical
        Exit Sub
    End If

    Set swDraw = swModel
    
    ' --- STEP 1: 全てのシートを走査 ---
    ' GetFirstSheetで最初のシートを取得し、GetNextSheetで次へ進む
    Dim vSheetNames As Variant
    vSheetNames = swDraw.GetSheetNames
    
    Dim i As Integer
    For i = 0 To UBound(vSheetNames)
        swDraw.ActivateSheet vSheetNames(i)
        Set swSheet = swDraw.GetCurrentSheet
        
        ' --- STEP 2: シート内の全てのビューを走査 ---
        ' GetFirstViewは「シート自体（Sheet View）」を最初に返すことに注意！
        Set swView = swDraw.GetFirstView
        
        Do While Not swView Is Nothing
            
            ' --- STEP 3: ビュー内の全ての注釈を走査 ---
            Set swAnn = swView.GetFirstAnnotation
            
            Do While Not swAnn Is Nothing
                
                ' --- STEP 4: ルール判定 (レイヤーチェック) ---
                ' 注釈のレイヤー名を取得
                Dim currentLayer As String
                currentLayer = swAnn.GetLayer
                
                ' もしレイヤーが正しくなければ、警告を描画
                If currentLayer <> CORRECT_LAYER Then
                    Call DrawWarning(swModel, swAnn, WARNING_TEXT)
                End If
                
                ' 次の注釈へ
                Set swAnn = swAnn.GetNextAnnotation
            Loop
            
            ' 次のビューへ
            Set swView = swView.GetNextView
        Loop
    Next i

    MsgBox "検図プロセスが完了しました。", vbInformation
End Sub

' =================================================================
' 警告描画サブ関数
' 引数: swModel (モデル), swAnn (違反箇所), msg (警告文)
' =================================================================
Private Sub DrawWarning(swModel As SldWorks.ModelDoc2, swAnn As SldWorks.Annotation, msg As String)
    Dim swNote As SldWorks.Note
    Dim vPos As Variant
    
    ' 違反箇所の座標を取得
    vPos = swAnn.GetPosition
    
    ' 注釈の種類を確認し、Note（テキスト系）として扱う
    ' (本来は型判定が必要だが、ここでは簡略化)
    Set swNote = swAnn.GetSpecificAnnotation
    
    ' 警告用の新しい注釈を、元の位置の少し横に作成
    ' ※座標系に注意。ここでは元の位置に直接上書きせず、少しずらす
    Dim swDrawing As SldWorks.DrawingDoc
    Set swDrawing = swModel
    
    ' 赤い文字の注釈を作成
    ' InsertNoteは、現在のビューに注釈を追加する
    swModel.InsertNote msg
    
    ' 作成した直後の注釈を取得して、色と位置を調整
    Dim swNewNote As SldWorks.Note
    Set swNewNote = swModel.SelectionManager.GetSelectedAnnotation2(1) ' 選択状態を利用する手法
    
    ' --- プロのこだわり: 見た目の制御 ---
    If Not swNewNote Is Nothing Then
        swNewNote.SetColor Red
        ' 座標を少しオフセット（元の注釈の右側へ）
        swNewNote.SetPosition vPos(0) + 0.01, vPos(1) + 0.01 
    End If
End Sub

4. 伝説のアーキテクトが教える「陥りやすい罠」

このコードを動かす前に、私が現場で何度も見てきた「失敗のパターン」を共有しておきます。ここをクリアすれば、あなたはもう初心者ではありません。

① `GetFirstView` の正体を知っているか？

多くの初心者が混乱するのが、`swDraw.GetFirstView` を実行したとき、最初に返ってくるのは「投影図（View）」ではなく、「シートそのもの（Sheet View）」であるという点です。
シートビューには、図枠やタイトルブロックが含まれています。もし、図枠のレイヤーもチェック対象にしたいなら、この最初のビューを無視してはいけません。

② 座標系の迷宮（Coordinate Systems）

SolidWorksには、「モデル座標」「シート座標」「ビュー座標」という複数の座標系が存在します。
`Annotation.GetPosition` で取得できる座標は、その注釈が属する「ビュー」の座標系に基づいています。警告を描画する際に、ビューの座標系を無視してシート座標で描画しようとすると、警告が全く違う場所に飛んでいってしまいます。

③ `Select` を多用しない

マクロの記録を見ると、`swModel.Extension.SelectByID2` という命令が頻発します。しかし、大量のエンティティを走査する際に `Select` を繰り返すと、SolidWorksの画面更新が追いつかず、処理速度が劇的に低下します。
プロは、オブジェクトを直接変数（`swAnn` など）に格納し、「選択せずに操作する」ことを意識します。

5. 次のステップへ：このツールをどう進化させるか？

今回のコードは「レイヤー違反」だけを扱いましたが、仕組みは同じです。

寸法漏れチェック: `swAnn.GetType` が `swAnnotationTypeDimension` かどうかを確認し、特定の重要な寸法が欠落していないか判定する。
フォントチェック: `swNote.GetTextFormat` を使い、規定のフォント（例：MSゴシック）以外を検知する。
レポート出力: 警告を描画するだけでなく、Excelに「どのシートのどのビューでエラーが出たか」を書き出す。

最後に

SolidWorks VBAは、単なる「お助けツール」ではありません。正しく扱えば、設計者の思考をデジタル化し、品質を担保する「強力な守護神」になります。

最初はエラーに泣かされることもあるでしょう。しかし、オブジェクトの階層を一つずつ解き明かしていくプロセスは、設計の本質を理解することと直結しています。

ここをクリアすれば、SolidWorks VBAの基本はバッチリですよ。
さあ、次はあなた自身の手で、世界に一つだけの自動検図システムを作り上げてください。応援しています！