テキストの文字列を一括で置換する｜AutoCAD VBAマクロの作成方法

本ページではVBAを使ってAutoCADのモデル空間名に存在するテキストの文字列を一括で置換する方法を解説していきます。(ここでいう”テキスト”はマルチテキスト/文字記入で生成された要素のこと)

機能としてはAutoCAD標準の[検索と置換](FIND)コマンドとほぼ同等ですが、VBAマクロで作成することにはいくつかのメリットがあります。VBAマクロを使用する場合、標準機能には存在しない細かい条件を追加できるため、例えば指定色のテキストや指定のフォントサイズのテキストのみを対象とした文字列置換を柔軟に行うことができます。

1. テキストの文字列を一括で置換する
2. サンプルコード
3. コード解説
4. まとめ

テキストの文字列を一括で置換する

本ページではテキスト内の文字列を一括で置換するマクロを解説していきます。
サンプルコードは下記のような仕様になっています。

マクロの機能まとめ・アクティブドキュメントのモデル空間内にあるテキストの文字列を置換する
・ブロック内にテキストがある場合はブロック内のテキストの文字列も置換する
・置換前と置換後の文字列はコード内で変更可能。
※マルチテキストで意図しない置換が行われる可能性あり(詳細はコード解説参照)

基本的には[検索と置換](FIND)コマンドでの置一括換と同じような機能ですが、条件分岐やファイルループの追加、Excelと連携することで標準のコマンドでは実現できないような文字列置換ツールに改変することも可能です。サンプルコードはあくまでもVBAでの文字列置換の根幹の部分のみの内容です。

サンプルコード

下記はアクティブドキュメントのモデル空間内にあるテキストの文字列を一括で置換するサンプルコードです。ブロックが存在する場合も、ブロック内のテキストにアクセスして文字列の置換を行います。コード17,18行目の「sBef」と「sAft」の値を変更することで任意の文字に置換することが出来ます。

'----------------------------------------------------------------------------------
'-
'-  ﾒｲﾝ処理
'-
'----------------------------------------------------------------------------------
Sub main()

    Dim oEntity As AcadEntity
    Dim oEntity2 As AcadEntity
    Dim oBlockRef As AcadBlockReference
    Dim oBlock As AcadBlock
    Dim sBlockName As String
    Dim cReplacedBlocks As Collection
    Dim sBef As String
    Dim sAft As String
    
    sBef = "置換前文字列"
    sAft = "置換後文字列"
    
    Set cReplacedBlocks = New Collection
    
    'ﾓﾃﾞﾙ空間内要素ﾙ-ﾌﾟ
    For Each oEntity In ThisDrawing.ModelSpace
    
        Select Case TypeName(oEntity)
        
        '■ﾏﾙﾁﾃｷｽﾄか文字の場合
        Case "IAcadMText", "IAcadText"
        
            '文字列の置換
            oEntity.TextString = Replace(oEntity.TextString, sBef, sAft)
        
        '■ﾌﾞﾛｯｸのｲﾝｽﾀﾝｽの場合
        Case "IAcadBlockReference"
         
            'ﾌﾞﾛｯｸ名称の取得
            Set oBlockRef = oEntity
            sBlockName = oBlockRef.EffectiveName
            
            '名称からｲﾝｽﾀﾝｽ元のﾌﾞﾛｯｸを取得
            Set oBlock = ThisDrawing.Blocks.Item(sBlockName)
            
            'ｺﾚｸｼｮﾝ内に同名のﾌﾞﾛｯｸが存在するか確認
            If IsIncludeCollection(cReplacedBlocks, oBlock) = False Then
            
                'ﾌﾞﾛｯｸ内要素ﾙ-ﾌﾟ
                For Each oEntity2 In oBlock
                
                    If TypeName(oEntity2) = "IAcadMText" Or _
                       TypeName(oEntity2) = "IAcadText" Then
    
                        'ﾏﾙﾁﾃｷｽﾄか文字の場合は文字列の置換
                        oEntity2.TextString = Replace(oEntity2.TextString, sBef, sAft)
    
                    End If
                Next
                
                '置換したﾌﾞﾛｯｸをｺﾚｸｼｮﾝに保存
                Call cReplacedBlocks.Add(oBlock)
                
            End If
            
        End Select
    Next

    '再作図(描画更新)
    Call ThisDrawing.Regen(acActiveViewport)

End Sub
'----------------------------------------------------------------------------------
'-  ｺﾚｸｼｮﾝ内に同名のﾌﾞﾛｯｸが存在するかを判定する
'-      cBlocks ：確認対象ｺﾚｸｼｮﾝ
'-      oBlock  ：存在確認するﾌﾞﾛｯｸ
'-      戻り値  ：[True] 存在する / [False] 存在しない
'----------------------------------------------------------------------------------
Private Function IsIncludeCollection(cBlocks As Collection, oBlock As AcadBlock) As Boolean

    Dim oBlockLoop 'As AcadBlock
    
    For Each oBlockLoop In cBlocks
        If oBlockLoop.Name = oBlock.Name Then
            IsIncludeCollection = True
            Exit Function
        End If
    Next

    IsIncludeCollection = False

End Function

'----------------------------------------------------------------------------------

'- ﾒｲﾝ処理

'----------------------------------------------------------------------------------

Sub main()

Dim oEntity As AcadEntity

Dim oEntity2 As AcadEntity

Dim oBlockRef As AcadBlockReference

Dim oBlock As AcadBlock

Dim sBlockName As String

Dim cReplacedBlocks As Collection

Dim sBef As String

Dim sAft As String

sBef = "置換前文字列"

sAft = "置換後文字列"

Set cReplacedBlocks = New Collection

'ﾓﾃﾞﾙ空間内要素ﾙ-ﾌﾟ

For Each oEntity In ThisDrawing.ModelSpace

Select Case TypeName(oEntity)

'■ﾏﾙﾁﾃｷｽﾄか文字の場合

Case "IAcadMText", "IAcadText"

'文字列の置換

oEntity.TextString = Replace(oEntity.TextString, sBef, sAft)

'■ﾌﾞﾛｯｸのｲﾝｽﾀﾝｽの場合

Case "IAcadBlockReference"

'ﾌﾞﾛｯｸ名称の取得

Set oBlockRef = oEntity

sBlockName = oBlockRef.EffectiveName

'名称からｲﾝｽﾀﾝｽ元のﾌﾞﾛｯｸを取得

Set oBlock = ThisDrawing.Blocks.Item(sBlockName)

'ｺﾚｸｼｮﾝ内に同名のﾌﾞﾛｯｸが存在するか確認

If IsIncludeCollection(cReplacedBlocks, oBlock) = False Then

'ﾌﾞﾛｯｸ内要素ﾙ-ﾌﾟ

For Each oEntity2 In oBlock

If TypeName(oEntity2) = "IAcadMText" Or _

TypeName(oEntity2) = "IAcadText" Then

'ﾏﾙﾁﾃｷｽﾄか文字の場合は文字列の置換

oEntity2.TextString = Replace(oEntity2.TextString, sBef, sAft)

End If

'置換したﾌﾞﾛｯｸをｺﾚｸｼｮﾝに保存

Call cReplacedBlocks.Add(oBlock)

End If

End Select

'再作図(描画更新)

Call ThisDrawing.Regen(acActiveViewport)

End Sub

'----------------------------------------------------------------------------------

'- ｺﾚｸｼｮﾝ内に同名のﾌﾞﾛｯｸが存在するかを判定する

'- cBlocks ：確認対象ｺﾚｸｼｮﾝ

'- oBlock ：存在確認するﾌﾞﾛｯｸ

'- 戻り値：[True] 存在する / [False] 存在しない

'----------------------------------------------------------------------------------

Private Function IsIncludeCollection(cBlocks As Collection, oBlock As AcadBlock) As Boolean

Dim oBlockLoop 'As AcadBlock

For Each oBlockLoop In cBlocks

If oBlockLoop.Name = oBlock.Name Then

IsIncludeCollection = True

Exit Function

End If

IsIncludeCollection = False

End Function

コード解説

サンプルコードの大まかなフローは下記の通りです。

① アクティブドキュメントのモデル空間内の要素をループ
　 (要素がブロックである場合はブロック内の要素でさらにループ)
② 要素がテキストである場合は文字列の置換を行う

アクティブドキュメントのモデル空間内の要素をループ

アクティブドキュメントのモデル空間はThisDrawing.ModelSpaceと表すことができるため、下記のように書くことでアクティブドキュメントのモデル空間内の要素でループ処理をすることができます。

モデル空間内の要素ループ

Dim oEntity As AcadEntity
For Each oEntity In ThisDrawing.ModelSpace
　
　　Select Case TypeName(oEntity)
　　Case “IAcadMText”, “IAcadText”

　　　　‘oEntityを使った処理
　　Case“IAcadBlockReference“
　　　　’oEntityを使った処理

　　End Select
　
Next

モデル空間内の要素がテキストかの条件分岐を行うにはTypeName関数を使ってoEntityのオブジェクトタイプを調べることで判定することができます。単一行テキストの場合は「IAcadText」、マルチテキストの場合は「IAcadMText」と別々に取得することができますが、ここではテキスト内の文字列置換を行うだけの共通処理のため、いずれかのテキストであれば置換処理を行うようにしています。

また、上記の条件だけではブロック内のテキストにアクセスすることはできません。ブロック内のテキストにアクセスするにはモデル空間内の要素でループ処理を行うのと同じように、ブロック内の要素でさらにループを行う必要があります。そのためには要素がブロックであるという判定を行う必要があります。これはテキスト判定と同じでオブジェクトタイプが「IAcadBlockReference」であるかを確認すれば判定ができます。モデル空間内に配置されているブロックはオリジナルのデータがインスタンス化(複製)されたものであるため、名前には”参照”を表すReferenceという文字が付与されています。
　

要素がブロックである場合はブロック内の要素でさらにループ

モデル空間内に配置されているブロックはオリジナルのブロックデータがインスタンス化されたものであるため、元のデータ内にあるテキストだけを置換すれば、それに紐づくブロックすべてのテキストが自動的に変更(更新)されます。そのためにはまず取得した「IAcadBlockReference」のインスタンス元となるオリジナルのブロック要素を取得する必要があります。

ブロック名はAcadBlockReferenceオブジェクトの「EffectiveName」プロパティで取得することができ、ブロック要素はThisDrawing.Blocksよりアクセスすることができるため、下記のように書くことでインスタンス化されたブロック要素からオリジナルのブロック要素を取得することができます。

インスタンス元のブロック要素を取得

Set oBlock = ThisDrawing.Blocks.Item(oBlockRef.EffectiveName)

oBlockRefがインスタンス化されたブロック要素(AcadBlockReferenceオブジェクト)で、oBlockがそのインスタンス元のブロック要素(AcadBlockオブジェクト)です。よって、このoBlock内にあるテキストの文字列を置換すれば、このoBlockからインスタンス化して作成されたすべてのoBlockRefの文字列もそれに合わせて自動的に変更されることになります。

インスタンス元のデータが同じブロック要素は多数存在するので、インスタンス化されたブロックの数によっては何度もインスタンス元のブロックにアクセスしてしまいます。そこで、サンプルコードでは1度置換処理を行ったブロックは2度目以降は無視をするという処理を行っています。これはCollectionに変更したブロック要素を格納していくことで、既に置換処理を行ったブロック要素なのか行っていないブロック要素なのかを判定することができるようにしています。

ブロック内要素のループは基本的にモデル空間内のループと考え方は同じで下記のように書きます。
このブロック内の要素でもモデル空間と同じようにテキスト判定を行えばモデル空間内にあるテキストだけでなく、モデル空間内のブロック内にあるテキストの文字列の置換もまとめて行うことができるようになります。(逆をいえばこの処理を無くせばブロック内テキストは置換の対象外にもできる)

ブロック内要素ループ

Dim oEntity2 As AcadEntity
For Each oEntity2 In oBlock
　　　　‘oEntity2を使った処理
Next

テキスト内の文字列置換を行う

要素がテキストであるかの判定ができたら実際にテキスト内の文字列を置換します。テキストの文字列にアクセスするには「TextString」プロパティを使います。このプロパティはAcadTextオブジェクト、AcadMTextオブジェクトのいずれにも存在しているため、単一行テキストとマルチテキストで処理を分ける必要はなく、共通の処理として下記のコードで置換処理を行うことが可能です。

テキストの文字列置換

oEntity.TextString = Replace(oEntity.TextString, sBef, sAft)

文字列の置換にはReplace関数を使います。引数として置換対象の文字列(oEntity.TextString)、置換前の文字列(sBef)、置換後の文字列(sAft)を入力することで、戻り値として置換された文字列を取得することができます。これをすべてのテキストに対して行えば文字列の一括置換が実現できます。

― MTextのTextString ― TextStringプロパティはテキストの文字列にアクセスするためのプロパティですがマルチテキストの場合は少し特殊な文字列が取得されます。マルチテキストでは画面に表示されている文字列の他に各文字列が持つフォントや色の書式情報が含まれます。

'
'   "{\fMS PGothic|b0|i0|c128|p50;テキスト}"
'

' "{\fMS PGothic|b0|i0|c128|p50;テキスト}"

このうち画面に表示されている文字列は”テキスト”の部分だけで、それ以外の文字列は全てその”テキスト”という文字列に係る情報となっています。この各情報の値を変更することで色やフォントを変えることもできるため使いようによっては便利ですが、今回のサンプルマクロのような置換を行う際に情報部分の文字列の置換が行われてしまう可能性があるため注意が必要です。
　
これを対応するには、一旦テキストの部分と情報の部分の文字列を別に切り分け、テキスト部分の置換をして、再度情報の部分に組み付けるという手間のかかる処理が必要になります。

　
上記処理により文字列の置換は行えますが、内部的な処理が済んだだけで画面にはすぐに反映されません。VBAマクロ実行後にAutoCAD内をクリックしたりカメラ操作を行えば変更結果が表示されますが、何も操作しないと置換処理ができていないように見えてしまいます。そこで、明示的に画面を再描画する方法として下記のコードを処理の最後に実行しています。

再作図の実行

Call ThisDrawing.Regen(acActiveViewport)

この処理を行うことで、AutoCAD内のアクティブなビューポートが再作図、すなわち画面描画の更新が行われます。AutoCADのVBAマクロでは最後の仕上げとして、この再作図処理を実行することが多いです。引数をacAllViewportsとすることですべてのビューポートの再作図を行うことも可能です。