画層の作成とプロパティ編集｜AutoCAD VBAマクロの作成方法

AutoCAD VBAで画層の作成と編集を行うにはLayerオブジェクトを利用する必要があります。本ページではこのLayerオブジェクトを使って画層の新規作成や削除、設定(表示やフリーズ、ロック、線種、線の太さなど)の変更をする方法を解説していきます。

本ページで学べる内容は以下のとおりです。

Layerオブジェクトについて
画層を新規作成する方法
既に存在している画層を取得する方法
画層の設定を変更する方法
画層を削除する方法

1. Layerオブジェクト
2. 画層プロパティの編集
3. 画層の削除
4. まとめ

Layerオブジェクト

AutoCAD VBAで画層を操作するにはLayerオブジェクトを使用します。
Layerオブジェクトを取得する基本的な方法として「現在アクティブの画層を取得」「指定の名称(もしくはインデックス)から画層を取得」「画層を新規作成して取得」の3つがあり、それぞれThisDrawingから下記のコードで取得することができます。既存の画層を編集したいのか新規で画層を作成したいのかによって取得方法が異なるため、状況に応じて使い分ける必要があります。


    Dim oLayer As AcadLayer
    
    '現在ｱｸﾃｨﾌﾞの画層を取得
    Set oLayer = ThisDrawing.ActiveLayer
    
    '指定の名称から画層を取得
    Set oLayer = ThisDrawing.Layers.Item("LayerName")
    
    '指定のｲﾝﾃﾞｯｸｽから画層を取得 (※ｲﾝﾃﾞｯｸｽは0始まり)
    Set oLayer = ThisDrawing.Layers.Item(0)
    
    '画層を新規作成
    Set oLayer = ThisDrawing.Layers.Add("LayerName")

Dim oLayer As AcadLayer

'現在ｱｸﾃｨﾌﾞの画層を取得

Set oLayer = ThisDrawing.ActiveLayer

'指定の名称から画層を取得

Set oLayer = ThisDrawing.Layers.Item("LayerName")

'指定のｲﾝﾃﾞｯｸｽから画層を取得 (※ｲﾝﾃﾞｯｸｽは0始まり)

Set oLayer = ThisDrawing.Layers.Item(0)

'画層を新規作成

Set oLayer = ThisDrawing.Layers.Add("LayerName")

「Layers.Add」で画層を新規作成する際、引数として画層の名前を入力します。このとき入力した名前の画層がすでに存在する場合、画層は新規作成されずにその名前の画層が取得されます。

　
プロパティ　

画層の設定を編集するには、Layerオブジェクトのプロパティにアクセスする必要があります。下表はLayerオブジェクトが持つ代表的なプロパティでこれらプロパティの値を変更することで、[画層プロパティ管理]を使って手作業で変更することのできるほとんどの設定をすることができます。

プロパティ名	内容
Name	画層の[名前]を取得/設定する
LayerOn	画層の[表示]設定を取得/設定する
Freeze	画層の[フリーズ]設定を取得/設定する
Lock	画層の[ロック]設定を取得/設定する
Plottable	画層の[印刷]設定を取得/設定する
TrueColor	画層の[色]設定を取得/設定する
Linetype	画層の[線種]設定を取得/設定する
Lineweight	画層の[線の太さ]設定を取得/設定する
ViewportDefault	画層の[新しいVPでフリーズ]設定を取得/設定する
Description	画層の[説明]設定を取得/設定する

上画像のようにVBAで新規作成した画層に対してプロパティを設定することが可能です。これは新規作成した画層だけでなく、既存の画層のプロパティを変更することもできますし、既に存在している各画層のプロパティが現在どのような設定になっているのかを取得することもできます。
　

画層プロパティの編集

Layerオブジェクトのプロパティを変更して画層プロパティの設定を行うためには下記のようなコードを記載します。基本的にはプロパティの値を直接変更すれば設定ができますし、値を取得すれば現在の設定を確認することができます。下記コードは画層を新規作成していますが、既存の画層を取得するコードに変更すれば既存の画層のプロパティを変更することができます。

Sub SetLayerProperty()

    Dim oLayer As AcadLayer
    Dim oColor As AcadAcCmColor
    
    '画層追加
    Set oLayer = ThisDrawing.Layers.Add("VBALayer")
    
    '名称変更
    oLayer.Name = "VBALayer2"
    
    '[表示]設定
    oLayer.LayerOn = False
    
    '[ﾌﾘｰｽﾞ]設定
    oLayer.Freeze = True
    
    '[ﾛｯｸ]設定
    oLayer.Lock = True
    
    '[印刷]設定
    oLayer.Plottable = False
    
    '[色]設定
    Set oColor = oLayer.TrueColor
    Call oColor.SetRGB(0, 128, 128)
    oLayer.TrueColor = oColor

    '[線種]設定
    On Error Resume Next
    Call ThisDrawing.Linetypes.Load("DASHDOT", "acadiso.lin")
    On Error GoTo 0
    oLayer.Linetype = "DASHDOT"
    
    '[線の太さ]設定
    oLayer.Lineweight = acLnWt050
    
    '[新しいVPでﾌﾘｰｽﾞ]設定
    oLayer.ViewportDefault = True
    
    '[説明]設定
    oLayer.Description = "VBAで新規作成した画層"
     
End Sub

Sub SetLayerProperty()

Dim oLayer As AcadLayer

Dim oColor As AcadAcCmColor

'画層追加

Set oLayer = ThisDrawing.Layers.Add("VBALayer")

'名称変更

oLayer.Name = "VBALayer2"

'[表示]設定

oLayer.LayerOn = False

'[ﾌﾘｰｽﾞ]設定

oLayer.Freeze = True

'[ﾛｯｸ]設定

oLayer.Lock = True

'[印刷]設定

oLayer.Plottable = False

'[色]設定

Set oColor = oLayer.TrueColor

Call oColor.SetRGB(0, 128, 128)

oLayer.TrueColor = oColor

'[線種]設定

On Error Resume Next

Call ThisDrawing.Linetypes.Load("DASHDOT", "acadiso.lin")

On Error GoTo 0

oLayer.Linetype = "DASHDOT"

'[線の太さ]設定

oLayer.Lineweight = acLnWt050

'[新しいVPでﾌﾘｰｽﾞ]設定

oLayer.ViewportDefault = True

'[説明]設定

oLayer.Description = "VBAで新規作成した画層"

End Sub

上記コードを見るとわかる通り、プロパティの値としてブール値(True/False)や文字列、定数などのデータ型を入力するだけなので、すぐに理解ができると思います。(※線の太さの定数はヘルプ参照)

[色]の設定と[線種]の設定については少し特殊な処理が必要となります。色の設定については「オブジェクトの色の取得と編集」ページで解説しているのであわせて参照ください。
　

線種のロードと設定

[線種]を設定する際はLinetypeプロパティに設定する線種の名前を指定します。
このとき、設定が可能な名前は既に図面にロードされている線種のみです。ロードされていない線種を設定するには、線種をロードする処理も必要になります。線種をロードする処理はThisDrawingからLinetypesオブジェクトにアクセスしてLoadメソッドを実行することで呼び出すことが可能です。

線種のロード

Call ThisDrawing.Linetypes.Load(LineTypeName, FileName)

LineTypeNameにはロードする線種の名前、FileNameにはロードする線種をもつファイルの名前(.lin)をそれぞれ入力します。それぞれどのような名前を付ければ良いかを調べるには[線種のロードまたは再ロード]の画面を起動することで確認することができます。(コマンドラインで[LINETYPE]実行等)

LinetypesオブジェクトのLoadメソッドは既にロードされている線種をロードしようとするとランタイムエラーが発生します。そのため、事前にロードされていないかの確認をする処理を行うか「On Error Resume Next」でエラーを無視するなどの対応が必要になるので使用する際は注意が必要です。
　　

画層の削除

LayerオブジェクトはAcadObjectから継承されたオブジェクトのため、AcadObjectがもつDeleteメソッドを使用することができます。Deleteメソッドは実行したオブジェクト自身を削除するためのメソッドで、下記のように記載します。(※[Layer] = 削除するLayerオブジェクト)

画層の削除

Call [Layer].Delete

削除する画層が現在アクティブであったり、画層内に要素が存在するなどの手作業でも削除できない画層に対してDeleteメソッドを実行すると、ランタイムエラーが発生し画層の削除に失敗します。

画層を削除するためにはアクティブの画層を切り替えたり、画層内のすべての要素を削除するなどの前処理を行っておく必要があります。下記コードは「画層内の全要素の削除」「アクティブ画層の切り替え」「画層のロック解除」を行い指定の画層を削除するためのサンプルコードです。

Sub main()

    '削除したい画層を入力
    Call ForceDeleteLayer(ThisDrawing.Layers.Item(1))

End Sub
Sub ForceDeleteLayer(ByVal oLayer As AcadLayer)

    Dim oEntity As AcadEntity
    
    'ﾛｯｸ解除
    oLayer.Lock = False
    
    '入力画層内の全要素を削除
    For Each oEntity In ThisDrawing.ModelSpace
        If oEntity.Layer = oLayer.Name Then
            oEntity.Delete
        End If
    Next
    
    'ｱｸﾃｨﾌﾞの画層を「0」に切り替え
    ThisDrawing.ActiveLayer = ThisDrawing.Layers.Item(0)
    
    '画層削除
    Call oLayer.Delete

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

End Sub

Sub main()

'削除したい画層を入力

Call ForceDeleteLayer(ThisDrawing.Layers.Item(1))

End Sub

Sub ForceDeleteLayer(ByVal oLayer As AcadLayer)

Dim oEntity As AcadEntity

'ﾛｯｸ解除

oLayer.Lock = False

'入力画層内の全要素を削除

For Each oEntity In ThisDrawing.ModelSpace

If oEntity.Layer = oLayer.Name Then

oEntity.Delete

End If

'ｱｸﾃｨﾌﾞの画層を「0」に切り替え

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

'画層削除

Call oLayer.Delete

'描画更新

Call ThisDrawing.Regen(acActiveViewport)

End Sub

まとめ

今回の内容をまとめると以下のとおりです。

画層の操作はLayerオブジェクトを使う
LayerオブジェクトはThisDrawing.ActiveLayerもしくはThisDrawing.Layers～で取得可能

Layerオブジェクトのプロパティを使うことで画層プロパティの取得と設定が可能
線種を設定するには事前に該当の線種を図面にロードさせておく必要がある
線種のロードはThisDrawing.Linetypes.Loadで可能
画層の削除はDeleteメソッドを呼び出すだけ (※アクティブな画層ではない必要がある)

本ページでは画層の取得方法及び画層プロパティの設定を取得/変更する方法についての内容でした。画層プロパティはTrue/False(ON/OFF)で表されるものも多く簡単に設定を変更することができます。
　

メインページへ戻る