画層数が多く、作業で表示やスリーズやロックを切り替える処理が繰り返しになるとき時間の無駄が多くなります。

そこで、同じ処理の繰り返しになる場合での対処法として、表題の画層状態コントロール用ExcelVBAを作成しました。

テスト用の画層

画層状態コントロール用のシート

実行用のボタンを1つ作成します。
OptionButton1，OptionButton2、OptionButton3　を
取得・戻す・変更とします。

まず、●取得でBCD列とEFG列に現在の状態を取得します。

事前にデーター欄のセルに入力規制で〇と●を設定してクリアで空欄にしています。

〇●の表示は以下にしています。

画層ON：〇、画層OFF：●
フリーズFALSE:〇、フリーズTRUE：●
ロックFALSE：〇、ロックTRUE：●

EFG列を変更する設定にします。

画層状態が変更設定通りに変更されました。

元の画層状態に戻す場合は、・戻るで、ABC列の元の状態に戻します。

更にOptionButton4、HIJ列と増やせば、別の組み合わせ処理もできますね。

Sub LayerStateControl()

''【BricsCADのオブジェクト変数を宣言】
Dim BcadApp As BricscadApp.AcadApplication
Dim BcadDoc As BricscadApp.AcadDocument
''現在開いているBricsCADを取得する
Set BcadApp = GetObject(, "BricscadApp.AcadApplication")
BcadApp.Visible = True
Set BcadDoc = BcadApp.ActiveDocument

Dim LayObj As AcadLayer
Dim LyrName As String
Dim i As Long

''==========【画層状態取得】========
If ActiveSheet.OptionButton1.Value = True Then
i = 3
    For Each LayObj In BcadDoc.Layers
        i = i + 1
        Cells(i, 1).Value = LayObj.Name
        If LayObj.LayerOn = True Then
            Cells(i, 2).Value = "〇"
            Cells(i, 5).Value = "〇"
        Else
            Cells(i, 2).Value = "●"
            Cells(i, 5).Value = "●"
        End If
        If LayObj.Freeze = False Then
            Cells(i, 3).Value = "〇"
            Cells(i, 6).Value = "〇"
        Else
            Cells(i, 3).Value = "●"
            Cells(i, 6).Value = "●"
        End If
        If LayObj.Lock = False Then
            Cells(i, 4).Value = "〇"
            Cells(i, 7).Value = "〇"
        Else
            Cells(i, 4).Value = "●"
            Cells(i, 7).Value = "●"
        End If
        
    Next

''==========【画層状態復旧】==========

ElseIf ActiveSheet.OptionButton2.Value = True Then
i = 3
    For Each LayObj In BcadDoc.Layers
    i = i + 1
    If Cells(i, 1).Value = LayObj.Name Then
        If Cells(i, 2).Value = "〇" Then
            LayObj.LayerOn = True
        Else
            LayObj.LayerOn = False
        End If
        If Cells(i, 3).Value = "〇" Then
            LayObj.Freeze = False
        Else
            LayObj.Freeze = True
        End If
        If Cells(i, 4).Value = "〇" Then
            LayObj.Lock = False
        Else
            LayObj.Lock = True
        End If
    End If

    Next

''==========【画層状態変更】==========

ElseIf ActiveSheet.OptionButton3.Value = True Then
i = 3
    For Each LayObj In BcadDoc.Layers
    i = i + 1
    If Cells(i, 1).Value = LayObj.Name Then
        If Cells(i, 5).Value = "〇" Then
            LayObj.LayerOn = True
        Else
            LayObj.LayerOn = False
        End If
        If Cells(i, 6).Value = "〇" Then
            LayObj.Freeze = False
        Else
            LayObj.Freeze = True
        End If
        If Cells(i, 7).Value = "〇" Then
            LayObj.Lock = False
        Else
            LayObj.Lock = True
        End If
    End If

    Next

End If
  
End Sub

Sub DataClear()

    ''取得データーをクリア
    Dim LastDataRow As Long
    LastDataRow = Cells(Rows.Count, 1).End(xlUp).Row
    ActiveSheet.Range(Rows(4), Rows(LastDataRow)).ClearContents
    Range("A2").Activate

End Sub

 

 

BricsCAD VBAを使ってみよう　INDEX

BricsCAD VBAを使ってみよう[1]　VBAのｲﾝｽﾄｰﾙ

BricsCAD VBAを使ってみよう[2]　UserFormその１
「BricsCAD VBA 」Creating UserForm

BricsCAD VBAを使ってみよう[3]　UserFormその２
「BricsCAD VBA 」SerialNumber drawing with UserForm

BricsCAD VBAを使ってみよう[4]　VBAの基本コード①

BricsCAD VBAを使ってみよう[5]　VBAの基本コード②

BricsCAD VBAを使ってみよう[6]　Excelとの連携①
「BricsCAD VBA to Excel」Get_CoordinateValues

BricsCAD VBAを使ってみよう[7]　Excelとの連携②　
「Excel VBA to BricsCAD」Get_Area

BricsCAD VBAを使ってみよう[8]　Excelとの連携②-2　
「Excel VBA to BricsCAD」Draw_ChannelSteel

BricsCAD VBAを使ってみよう[9]　TABLEの自動作成と値入力
「BricsCAD VBA 」AutomaticCreation of TABLE

BricsCAD VBAを使ってみよう[10]　Excelとの連携②-3
「Excel VBA to BricsCAD」SerialNumber_Ⅱ

BricsCAD VBAを使ってみよう[11]　Excelとの連携②-4 
「Excel VBA to BricsCAD」Draw_Rectang

BricsCAD VBAを使ってみよう[12]　Excelとの連携②-5 指定画層にOffset
「Excel VBA to BricsCAD」Continuous Offset to Specified Layer

BricsCAD VBAを使ってみよう[13]　Excelとの連携②-6 指定画層にHATCH
「Excel VBA to BricsCAD」Continuous Hatch to Specified Layer

BricsCAD VBAを使ってみよう[14]　Excelとの連携②-7　長さ計測
「Excel VBA to BricsCAD」Get Length

 

以下検討中です。

◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇
「この特集記事の内容につきましては、
こちらの環境のみの検討結果です。
動作保証は出来かねますため、ご参考
資料としてお扱いください。
Windows11（64bit）
BricsCAD pro V21（64bit）
Office2019（64bit）
◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇