使用されていない画層を一括削除するマクロ｜AutoCAD VBAマクロの作成方法

今回のサンプルマクロはアクティブの図面(ドキュメント)内で使用されていない画層を一括削除するマクロです。この機能自体はAutoCAD標準の[名前削除](PURGE)コマンドで用意されていますが、VBAで行うことで削除の条件(例えばロックしている画層は対象外など)を付与することが可能になります。
　

1. マクロ機能
2. サンプルコード
3. コード解説　
4. まとめ

マクロ機能

マクロの機能まとめ・アクティブな図面内で使用されていない画層を一括削除する
・削除前に確認メッセージを表示する

サンプルコード

マクロのサンプルコードは下記のとおりです。
実行すると現在アクティブとなっている図面に対して処理が実行されます。

Option Explicit
Sub main()

    Dim oLayer As AcadLayer
    Dim cLayers As Collection
    Dim sMsg As String
    Dim lRet  As Long
    
    Set cLayers = New Collection

    '画層が使用中かどうかを示すﾃﾞｰﾀの作成
    Call ThisDrawing.Layers.GenerateUsageData
    
    'ﾄﾞｷｭﾒﾝﾄ内の全画層ﾙｰﾌﾟ
    For Each oLayer In ThisDrawing.Layers
        
        '使用されていないか判定
        If oLayer.Used = False Then
        
            'ｺﾚｸｼｮﾝに格納
            Call cLayers.Add(oLayer)
            
            '確認ﾒｯｾｰｼﾞ用の文字列作成
            sMsg = sMsg & vbLf & "・" & oLayer.Name
        End If
    Next
    
    '全画層が使用中の場合は終了
    If cLayers.Count = 0 Then
        Call MsgBox("すべての画層が使用中です。", vbInformation)
        Exit Sub
    End If
    
    '確認ﾒｯｾｰｼﾞ表示
    sMsg = "下記の画層を削除します。" & vbLf & sMsg
    lRet = MsgBox(sMsg, vbOKCancel + vbInformation)
    
    '[OK]ﾎﾞﾀﾝが押された場合は不使用の全画層を削除
    If lRet = vbOK Then
        ThisDrawing.ActiveLayer = ThisDrawing.Layers.Item(0)
        For Each oLayer In cLayers
            Call oLayer.Delete
        Next
    End If

End Sub

Option Explicit

Sub main()

Dim oLayer As AcadLayer

Dim cLayers As Collection

Dim sMsg As String

Dim lRet As Long

Set cLayers = New Collection

'画層が使用中かどうかを示すﾃﾞｰﾀの作成

Call ThisDrawing.Layers.GenerateUsageData

'ﾄﾞｷｭﾒﾝﾄ内の全画層ﾙｰﾌﾟ

For Each oLayer In ThisDrawing.Layers

'使用されていないか判定

If oLayer.Used = False Then

'ｺﾚｸｼｮﾝに格納

Call cLayers.Add(oLayer)

'確認ﾒｯｾｰｼﾞ用の文字列作成

sMsg = sMsg & vbLf & "・" & oLayer.Name

End If

'全画層が使用中の場合は終了

If cLayers.Count = 0 Then

Call MsgBox("すべての画層が使用中です。", vbInformation)

Exit Sub

End If

'確認ﾒｯｾｰｼﾞ表示

sMsg = "下記の画層を削除します。" & vbLf & sMsg

lRet = MsgBox(sMsg, vbOKCancel + vbInformation)

'[OK]ﾎﾞﾀﾝが押された場合は不使用の全画層を削除

If lRet = vbOK Then

ThisDrawing.ActiveLayer = ThisDrawing.Layers.Item(0)

For Each oLayer In cLayers

Call oLayer.Delete

End If

End Sub

コード解説　

使用されていない画層の取得

画層が使用されているかの判定はLayerオブジェクトのUsedプロパティで判定することができます。ただし、このプロパティを使う前にLayersオブジェクトのGenerateUsageDataメソッドを実行しておく必要があります。このメソッドは画層が使用中かどうかを示すデータを作成するためのメソッドで、実行しないとUsedプロパティで取得できる値が最新の情報でない場合があるため注意が必要です。

アクティブな図面内に存在する画層はLayersオブジェクト内ループをすることで、すべての画層(Layerオブジェクト)にアクセスすることができます。画層が使用されていない場合(UsedがFalse)は削除対象としてコレクションに格納しています。(確認メッセージが不要であればここで削除でも可)


    'ﾄﾞｷｭﾒﾝﾄ内の全画層ﾙｰﾌﾟ
    For Each oLayer In ThisDrawing.Layers
        
        '使用されていないかを判定
        If oLayer.Used = False Then
        
            'ｺﾚｸｼｮﾝに格納
            Call cLayers.Add(oLayer)

        End If
    Next

'ﾄﾞｷｭﾒﾝﾄ内の全画層ﾙｰﾌﾟ

For Each oLayer In ThisDrawing.Layers

'使用されていないかを判定

If oLayer.Used = False Then

'ｺﾚｸｼｮﾝに格納

Call cLayers.Add(oLayer)

End If

画層の削除

画層の削除はLayerオブジェクト(Entityオブジェクト)のDeleteメソッドを実行することで削除することができます。このとき削除対象の画層がアクティブになっていると削除をすることができなくなるため、アクティブの画層を「0」に切り替える処理を実行しています。

アクティブな画層を切り替えるには「ThisDrawing.ActiveLaye」に対象のLayerオブジェクトを入力することで切り替えられます。ここでは確実に存在する画層0を代入して切り替えを行っています。

現在の画層の変更

ThisDrawing.ActiveLayer = ThisDrawing.Layers.Item(0)

まとめ

今回のマクロはAutoCADの標準機能として用意されていますが、VBAでも再現できるというところが重要です。VBAを使うことでExcelなど別のアプリケーションと連携させることができるためExcelシートに記載されている画層だけを削除したり、使用されていない画層のうち名前に指定の文字列を含む画層のみを削除したりなど、より細かい処理を設定することができます。

メインページへ戻る