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

mccad · 发表于 2002-5-28 21:03:00

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 · 发表于 2002-5-28 21:06:00

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 · 发表于 2006-6-14 16:31:00

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

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

发表回复

精选推荐