【実務・中級編】【初心者向け】図面内の特定領域に配置したメモ注記のフォントサイズ・太字一括変更マクロ – SolidWorks VBA解析バイブル

凡ミスを「仕組み」で排除せよ：図面注記のスタイルを一括制御する、設計思考に基づいたVBAの実装術

設計現場で、図面の仕上げ作業に追われていないだろうか？
「注記のフォントサイズがバラバラだ」「特定のエリアのメモだけ太字にしたい」……。こうした、本来設計者が思考すべきではない「微調整」に時間を溶かすのは、エンジニアリングにおける敗北である。

多くの初心者は、このような要望に対し「全ての注記をループで回して、文字列を判定して書き換える」という、極めて脆く、非効率なコードを書く。しかし、それでは不十分だ。オブジェクトの階層構造を理解せず、座標系を無視したコードは、図面の構成が変わった瞬間にゴミ同然の挙動を示す。

本記事では、単なる「動くコード」ではなく、「堅牢（Robust）で、拡張性が高く、パフォーマンスを意識した」プロフェッショナルな注記制御マクロの書き方を伝授する。

1. アーキテクチャの理解：SolidWorks APIの階層を制する

まず、我々が操作しようとしている対象の「正体」を正しく理解しなければならない。
SolidWorksの図面において、注記（Note）は単独で存在するのではない。

1. DrawingDoc (図面ドキュメント)
2. Sheet (シート)
3. View (ビュー) または Sheet (シート直下の要素)
4. Annotation (注記の基底オブジェクト)
5. Note (テキスト情報を保持する具象オブジェクト)

ここが最大の落とし穴だ。フォントサイズや太字といった「見た目」のプロパティは `Note` オブジェクトが持つが、その注記が「図面のどの位置にあるか」という空間情報は、親クラスである `Annotation` オブジェクトが管理している。

「特定の領域にある注記」を制御したいのであれば、Annotationの座標（Bounding Box）を取得し、それを判定ロジックに組み込む。これが、プロフェッショナルな設計の第一歩である。

2. 実装の要：空間フィルタリング・アルゴリズム

「特定の領域」を定義するには、矩形領域（最小X, 最小Y, 最大X, 最大Y）をパラメータとして持つ関数を設計するのが最もスマートだ。

また、SolidWorksの内部単位は基本的にメートル（m）である。ミリメートル（mm）で指定したい実務者のために、単位変換のレイヤーをコード内に設ける。これを怠ると、座標計算で必ずバグを生むことになる。

3. プロダクション・グレードのコード例

以下に、実務でそのまま利用可能な、保守性の高いコードを示す。このコードは、単なるループ処理ではなく、エラーハンドリングとモジュール化を徹底している。

'==============================================================================
' Module: DrawingAnnotationManager
' Description: 図面内の特定領域にある注記のスタイルを一括変更する
' Author: Chief Architect
'==============================================================================

Option Explicit

' 設定値：単位変換用
Private Const MM_TO_M As Double = 0.001

Sub Main()
    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
        MsgBox "図面ファイルを開いてから実行してください。", vbCritical
        Exit Sub
    End If
    
    If swModel.GetType <> swDocDRAWING Then
        MsgBox "このマクロは図面ドキュメント専用です。", vbCritical
        Exit Sub
    End If
    
    Set swDraw = swModel
    
    ' 2. ターゲット領域の定義 (単位: mm)
    ' 例: シートの左下(0,0)から、右へ100mm、上へ50mmの範囲
    Dim targetMinX As Double: targetMinX = 10#
    Dim targetMinY As Double: targetMinY = 10#
    Dim targetMaxX As Double: targetMaxX = 110#
    Dim targetMaxY As Double: targetMaxY = 60#
    
    ' 3. 変更したいスタイル設定
    Dim newFontSize As Double: newFontSize = 3.5  ' mm単位
    Dim isBold As Boolean: isBold = True
    
    ' 4. 処理実行
    Debug.Print "--- 処理開始 ---"
    ProcessDrawingArea swDraw, targetMinX, targetMinY, targetMaxX, targetMaxY, newFontSize, isBold
    Debug.Print "--- 処理完了 ---"
    
    ' 再描画して結果を反映
    swModel.GraphicsRedraw2
    MsgBox "注記のクリーンアップが完了しました。", vbInformation

    Exit Sub

ErrorHandler:
    MsgBox "予期せぬエラーが発生しました: " & Err.Description, vbCritical
End Sub

''' <summary>
''' 図面内の全シート・全ビューを走査し、指定領域内の注記を更新する
''' </summary>
Private Sub ProcessDrawingArea(swDraw As SldWorks.DrawingDoc, _
                               minX As Double, minY As Double, maxX As Double, maxY As Double, _
                               fontSize As Double, bold As Boolean)
    
    Dim vSheets As Variant
    Dim swSheet As SldWorks.Sheet
    Dim i As Integer
    
    ' シートの取得
    vSheets = swDraw.GetSheetNames
    
    For i = 0 To UBound(vSheets)
        swDraw.ActivateSheet vSheets(i)
        Set swSheet = swDraw.GetCurrentSheet
        
        ' シート直下の注記を処理
        ProcessSheetAnnotations swSheet, minX, minY, maxX, maxY, fontSize, bold
        
        ' ビュー内の注記を処理
        Dim vViews As Variant
        Dim swView As SldWorks.View
        Dim j As Integer
        
        vViews = swSheet.GetViews
        For j = 0 To UBound(vViews)
            Set swView = vViews(j)
            ' ビュー内の注記を走査
            ProcessViewAnnotations swView, minX, minY, maxX, maxY, fontSize, bold
        Next j
    Next i
End Sub

''' <summary>
''' シート直下の注記を処理
''' </summary>
Private Sub ProcessSheetAnnotations(swSheet As SldWorks.Sheet, minX As Double, minY As Double, maxX As Double, maxY As Double, fontSize As Double, bold As Boolean)
    Dim swAnn As SldWorks.Annotation
    Dim swNote As SldWorks.Note
    Dim vAnns As Variant
    Dim k As Integer
    
    ' シート上の注記（Annotation）を取得
    vAnns = swSheet.GetAnnotations
    If IsEmpty(vAnns) Then Exit Sub
    
    For k = 0 To UBound(vAnns)
        Set swAnn = vAnns(k)
        ' 注記（Note）であるか確認
        If swAnn.GetType = swAnnotationType_e.swAnnotationType_Note Then
            Set swNote = swAnn
            ' 領域判定を行い、条件を満たせば適用
            If IsInArea(swAnn, minX, minY, maxX, maxY) Then
                ApplyNoteStyle swNote, fontSize, bold
            End If
        End If
    Next k
End Sub

''' <summary>
''' ビュー内の注記を処理
''' </summary>
Private Sub ProcessViewAnnotations(swView As SldWorks.View, minX As Double, minY As Double, maxX As Double, maxY As Double, fontSize As Double, bold As Boolean)
    Dim swAnn As SldWorks.Annotation
    Dim swNote As SldWorks.Note
    Dim vAnns As Variant
    Dim k As Integer
    
    ' ビュー内の注記を取得
    vAnns = swView.GetAnnotations
    If IsEmpty(vAnns) Then Exit Sub
    
    For k = 0 To UBound(vAnns)
        Set swAnn = vAnns(k)
        If swAnn.GetType = swAnnotationType_e.swAnnotationType_Note Then
            Set swNote = swAnn
            ' 領域判定
            If IsInArea(swAnn, minX, minY, maxX, maxY) Then
                ApplyNoteStyle swNote, fontSize, bold
            End If
        End If
    Next k
End Sub

''' <summary>
''' 注記が指定した矩形領域内にあるかを判定する
''' </summary>
Private Function IsInArea(swAnn As SldWorks.Annotation, minX As Double, minY As Double, maxX As Double, maxY As Double) As Boolean
    Dim vBox As Variant
    Dim annMinX As Double, annMinY As Double, annMaxX As Double, annMaxY As Double
    
    ' Annotationのバウンディングボックスを取得 [MinX, MinY, MaxZ, MaxX, MaxY, MaxZ]
    vBox = swAnn.GetBoundingBox
    
    ' メートルからミリメートルへ変換して比較
    annMinX = vBox(0) / MM_TO_M
    annMinY = vBox(1) / MM_TO_M
    annMaxX = vBox(3) / MM_TO_M
    annMaxY = vBox(4) / MM_TO_M
    
    ' 矩形の中心点が指定領域内にあるか、あるいは重なっているかを判定
    ' ここでは「注記の左下点が指定範囲内にあるか」というロジックを採用
    If annMinX >= minX And annMinX <= maxX And annMinY >= minY And annMinY <= maxY Then
        IsInArea = True
    Else
        IsInArea = False
    End If
End Function

''' <summary>
''' 注記のスタイルを適用する
''' </summary>
Private Sub ApplyNoteStyle(swNote As SldWorks.Note, fontSize As Double, bold As Boolean)
    ' フォントサイズの設定 (単位はメートルに変換して渡す必要がある)
    ' 注意: Note.SetTextFormatを使用するか、TextFormatプロパティを操作する
    ' ここではシンプルにTextFormatを操作するアプローチをとる
    
    Dim swTextFormat As SldWorks.TextFormat
    Set swTextFormat = swNote.GetTextFormat
    
    ' フォントサイズの変更
    swTextFormat.Height = fontSize * MM_TO_M
    ' 太字の設定
    swTextFormat.Bold = bold
    
    ' 変更を適用
    swNote.SetTextFormat swTextFormat
End Sub

4. プロフェッショナルの視点：なぜこの書き方なのか

このコードが、巷にある「コピペ用コード」と決定的に違う点は以下の3点だ。

① 単一責任の原則 (Single Responsibility Principle)

`ProcessDrawingArea` は「走査」を、`IsInArea` は「判定」を、`ApplyNoteStyle` は「適用」を担っている。
もし将来、「フォントの色も変えたい」となった場合、君は `ApplyNoteStyle` だけを修正すればいい。`IsInArea` のロジックを壊す必要はない。これが保守性の高い設計だ。

② 空間判定の精度

`GetBoundingBox` を使い、`Annotation` オブジェクトから直接座標を引いている。これにより、注記が「ビューの中にあるのか」「シート直下にあるのか」に関わらず、図面上の絶対座標で判定が可能になる。これは、複雑なアセンブリ図面を扱う上で不可欠な技術だ。

③ 防御的プログラミング (Defensive Programming)

`If swModel Is Nothing Then` や `If swModel.GetType <> swDocDRAWING` といったバリデーションを冒頭に置いている。
自動化ツールを配布した際、ユーザーが「間違ったファイル」を開いたまま実行して、マクロがクラッシュし、SolidWorksごと落ちる……。そんな初歩的なミスは、プロのエンジニアが最も避けるべき事態だ。

5. さらなる高みへ：実務での拡張アイデア

このコードをベースに、業務をさらに進化させるなら以下のステップを検討せよ。

1. 外部パラメータ化:
判定領域やフォントサイズをコードにハードコードするのではなく、Excelファイルや外部の `.ini` ファイルから読み込むように設計変更する。これにより、非エンジニアでも設定を変更できるようになる。
2. 正規表現によるフィルタリング:
`swNote.GetText` を使い、特定のキーワード（例：「REVISION」や「NOTES:」）を含む注記のみを対象にするロジックを追加すれば、さらに精度は高まる。
3. ログ出力:
どの注記を変更したかを `Debug.Print` だけでなく、テキストファイルに書き出すようにする。これにより、大量の図面をバッチ処理した際の「証跡」が得られる。

まとめ

自動化とは、単に「楽をするための手段」ではない。「人間が本来集中すべき、価値の高い作業にリソースを割り当てるための投資」である。

今回学んだ「オブジェクトの階層構造」「空間フィルタリング」「モジュール化」という概念は、SolidWorks APIに限らず、あらゆるソフトウェア開発に通底する極めて重要な原則だ。これらを意識して、次なる自動化ツールを構築せよ。