・ 新しい画層を作る
・ 現在層を変更する

'***********************************************************************************************
'画層を変更する
'変更したい画層が存在しない場合は作成する
'***********************************************************************************************
Sub Jo_sel_lay()

  Dim obj_layer_def As AcadLayer

  Set obj_layer_def = ThisDrawing.ActiveLayer
  On Error Resume Next
  ThisDrawing.ActiveLayer = ThisDrawing.Layers.Item("EXTLINE-U-") '現在層の変更
  If Err Then '画層がなければエラーになる
    Err.Clear
    On Error GoTo 0
    Call Jo_make_lay("EXTLINE-U-", 3, "CONTINUOUS") '画層がなければ新しい画層を作成するプロシージャーに
  End If
  On Error GoTo 0

End Sub

'***********************************************************************************************
'新しい画層を作して現在層に設定する
' str_lay:画層名　int_col：Bylayer色　str_ltype：Bylayer線種
'***********************************************************************************************
Sub Jo_make_lay(str_lay, int_col, str_ltype)

  Dim obj_layer As AcadLayer

  Set obj_layer = ThisDrawing.Layers.Add(str_lay)
  obj_layer.Color = int_col
  obj_layer.Linetype = str_ltype
  ThisDrawing.ActiveLayer = obj_layer

End Sub