使用されていない画層を一括削除するマクロ｜AutoCAD VBAマクロの作成方法
今回のサンプルマクロはアクティブの図面(ドキュメント)内で使用されていない画層を一括削除するマクロです。この機能自体はAutoCAD標準の[名前削除](PURGE)コマンドで用意されていますが、VBAで行うことで削除の条件(例えばロックしている画層は対象外など)を付与することが可能になります。
マクロ機能
・削除前に確認メッセージを表示する
サンプルコード
マクロのサンプルコードは下記のとおりです。
実行すると現在アクティブとなっている図面に対して処理が実行されます。
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
コード解説
使用されていない画層の取得
画層が使用されているかの判定は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
画層の削除
画層の削除はLayerオブジェクト(Entityオブジェクト)のDeleteメソッドを実行することで削除することができます。このとき削除対象の画層がアクティブになっていると削除をすることができなくなるため、アクティブの画層を「0」に切り替える処理を実行しています。
アクティブな画層を切り替えるには「ThisDrawing.ActiveLaye」に対象のLayerオブジェクトを入力することで切り替えられます。ここでは確実に存在する画層0を代入して切り替えを行っています。
ThisDrawing.ActiveLayer = ThisDrawing.Layers.Item(0)
まとめ
今回のマクロはAutoCADの標準機能として用意されていますが、VBAでも再現できるというところが重要です。VBAを使うことでExcelなど別のアプリケーションと連携させることができるためExcelシートに記載されている画層だけを削除したり、使用されていない画層のうち名前に指定の文字列を含む画層のみを削除したりなど、より細かい処理を設定することができます。
関連書籍
