[例程]图层操作：添加图层、获取图层、切换图层

mccad

Public Sub UseLayer()

Dim layObj As AcadLayer
Set layObj = ThisDrawing.Layers.Add("testLayer")

End Sub

Public Sub GetLayer()

Dim layName As String
'Set layObj = ThisDrawing.Layers.Item(1)
'Set layObj = ThisDrawing.Layers.Item("testLayer")
'Set layObj = ThisDrawing.Layers(1)
Set layObj = ThisDrawing.Layers("testLayer")

layName = layObj.Name
MsgBox "层名称为：" & layName

MsgBox "层的数量：" & ThisDrawing.Layers.Count

End Sub

Public Sub LayerChange()
    Dim cirObj As AcadCircle
    Dim center(0 To 2) As Double
    Dim radius As Double
   
    center(0) = 256: center(1) = 182: center(2) = 0
    radius = 38
    Set cirObj = ThisDrawing.ModelSpace.AddCircle(center, radius)

    MsgBox "现在圆所在的层为：" & cirObj.Layer
   
    Dim newLayer As AcadLayer
    Set newLayer = ThisDrawing.Layers("Layer1")
    cirObj.Layer = "Layer1"
   
    MsgBox "现在圆所在的层为：" & cirObj.Layer
   
    newLayer.Freeze = True
   
End Sub

mccad

Public Sub UseLayer()

Dim layObj As AcadLayer
Set layObj = ThisDrawing.Layers.Add("testLayer")

End Sub

Public Sub GetLayer()

Dim layName As String
'Set layObj = ThisDrawing.Layers.Item(1)
'Set layObj = ThisDrawing.Layers.Item("testLayer")
'Set layObj = ThisDrawing.Layers(1)
Set layObj = ThisDrawing.Layers("testLayer")

layName = layObj.Name
MsgBox "层名称为：" & layName

MsgBox "层的数量：" & ThisDrawing.Layers.Count

End Sub

Public Sub LayerChange()
    Dim cirObj As AcadCircle
    Dim center(0 To 2) As Double
    Dim radius As Double
   
    center(0) = 256: center(1) = 182: center(2) = 0
    radius = 38
    Set cirObj = ThisDrawing.ModelSpace.AddCircle(center, radius)

    MsgBox "现在圆所在的层为：" & cirObj.Layer
   
    Dim newLayer As AcadLayer
    Set newLayer = ThisDrawing.Layers("Layer1")
    cirObj.Layer = "Layer1"
   
    MsgBox "现在圆所在的层为：" & cirObj.Layer
   
    newLayer.Freeze = True
   
End Sub

dchlmz

图层操作中能不设定为某一个图层不打印？