VB编程操作AtuoCAD图层

通过设置各图层的不同属性，调用图层的方法，可对不同类的图形对象分组编辑和管理，例如，可以创建一个专门画中心线的图层，将图层颜色属性设置为蓝色，线性定义为中心线，当需要画中心线时，就转到该层即可，而不是每次画中心线时都重新设置线型和颜色。

• 创建并命名图层

新的图形文件建立时，系统自动创建一个名为”0“的图层，用Add方法可以创建新图层，也可同时给它命名。下面代码创建一个testlayer的图层，并将一个圆置于该图层。

Private Sub Command1_Click()

Dim testlayer As AcadLayer

Set testlayer = acadapp.ActiveDocument.Layers.Add("test")

testlayer.Color = acBlue

Dim circleobj As AcadCircle

Dim centerpoint(0 To 2) As Double

Dim radius As Double

centerpoint(0) = 0#: centerpoint(1) = 0#: centerpoint(2) = 0#

radius = 5#

Set circleobj = acadapp.ActiveDocument.ModelSpace.AddCircle(centerpoint, radius)

circleobj.Layer = "test"

circleobj.Color = acByLayer

circleobj.Update

End Sub

• 设置当前图层

当有几个图层时，总是在激活的当前图层上绘图，若为指定当前图层，将在默认的0图层上绘图，文档对象的ActiveLayer属性可以将某图层设置为当前图层。

下面的程序创建名为A、B的两个图层，颜色一为蓝色，一为黄色，依次设置为当前图层，并在上面各绘制一个圆，颜色默认值acByLayer，一蓝一红，与所在图层颜色相同。

Private Sub Command1_Click()

Dim testlayer1 As AcadLayer

Dim testlayer2 As AcadLayer

Set testlayer1 = acadapp.ActiveDocument.Layers.Add("A")

Set testlayer2 = acadapp.ActiveDocument.Layers.Add("B")

testlayer1.Color = acBlue

testlayer2.Color = acRed

Dim circleobj1 As AcadCircle

Dim circleobj2 As AcadCircle

Dim centerpoint(0 To 2) As Double

Dim radius As Double

centerpoint(0) = 0#: centerpoint(1) = 0#: centerpoint(2) = 0#

radius = 5#

acadapp.ActiveDocument.ActiveLayer = testlayer1

Set circleobj1 = acadapp.ActiveDocument.ModelSpace.AddCircle(centerpoint, radius)

acadapp.ActiveDocument.ActiveLayer = testlayer2

Set circle2 = acadapp.ActiveDocument.ModelSpace.AddCircle(centerpoint, radius / 2)

ZoomExtents

End Sub

• 开关图层

将图层的LayerOn属性设置为False，关闭图层，设置为True，打开图层。

关闭图层上的对象不显示，但是可以在其上创建新对象，但当时不能显示出来，当在可见图层和非可见图层之间频繁切换时，关闭图层比冻结图层更好些。下面的图层创建一个图层A，其上创建一个圆，然后关闭该图层并在其上添加一个圆，最后打开图层。

程序运行后先显示为一个黑色的圆，然后随着图层的关闭，虽然又添加了一个圆，但看不见任何圆，打开图层后，图层A上将显示两个圆。

Private Sub Command1_Click()

Dim testlayer As AcadLayer

Set testlayer = acadapp.ActiveDocument.Layers.Add("A")

acadapp.ActiveDocument.ActiveLayer = testlayer

Dim circleobj1 As AcadCircle

Dim circleobj2 As AcadCircle

Dim centerpoint(0 To 2) As Double

centerpoint(0) = 0#: centerpoint(1) = 0#: centerpoint(2) = 0#

Set circleobj1 = acadapp.ActiveDocument.ModelSpace.AddCircle(centerpoint, 1)

circleobj1.Update

ZoomExtents

MsgBox "将关闭图层并在其上添加一个圆"

testlayer.LayerOn = False

Set circle2 = acadapp.ActiveDocument.ModelSpace.AddCircle(centerpoint, 3)

ZoomExtents

AppActivate acadapp.Caption

MsgBox "将打开图层"

testlayer.LayerOn = True

acadapp.ActiveDocument.Regen acActiveViewport

End Sub

• 冻结和解冻图层

将图层的Freeze属性设置为True，将冻结图层，设置为False，将解冻图层。

在冻结状态，图层上对象不显示，不能创建新对象，但可以编辑已有对象，当前图层不能冻结冻结图层可以加快显示变化，对于复杂的图形可以减少重新生成的次数。下面的程序创建两个图层：A和B在图层A上创建一个圆，然后将当前图层设置为B，冻结图层A，修改圆的颜色，再解冻图层A。

程序运行后，先显示一个黑色的圆，然后随着该图层的冻结而不可见，解冻后该圆又可见，且显示为红色。

Private Sub Command1_Click()

Dim testlayer1 As AcadLayer

Dim testlayer2 As AcadLayer

Set testlayer1 = acadapp.ActiveDocument.Layers.Add("A")

Set testlayer2 = acadapp.ActiveDocument.Layers.Add("B")

acadapp.ActiveDocument.ActiveLayer = testlayer1

Dim circleobj As AcadCircle

Dim centerpoint(0 To 2) As Double

Dim radius As Double

centerpoint(0) = 0#: centerpoint(1) = 0#: centerpoint(2) = 0#

radius = 5#

Set circleobj = acadapp.ActiveDocument.ModelSpace.AddCircle(centerpoint, radius)

circleobj.Update

acadapp.ActiveDocument.ActiveLayer = testlayer2

MsgBox "将冻结图层，并修改圆的颜色"

testlayer1.Freeze = True

circleobj.Update

circleobj.Color = acRed

MsgBox "将冻结图层"

testlayer1.Freeze = False

circleobj.Update

End Sub

• 锁住和解锁图层

将图层的Lock属性设置为True，将锁住图层，设置为False，可将图层解锁。被锁住的图层上可以显示对象，也可以将其设置为当前图层并在上面常见对象，但不可以编辑或修改被锁住的图层上的对象，当需要显示图层作为参照，有希望图层上的图形不被误修改，可以将该图层设置为锁住状态。

下面的程序在当前图层绘制一些图层，然后运行下面的程序将当前图层锁住，此时图层上的图形均可见，但不能用鼠标拖动或编辑图层上的图形，开锁图层后，就可以编辑图层上的图形了。

Private Sub Command1_Click()

Dim layerobj As AcadLayer

Set layerobj = acadapp.ActiveDocument.ActiveLayer

layerobj.Lock = True

MsgBox "当前图层已经开锁，可以编辑"

layerobj.Lock = False

AppActivate acadapp.Caption

End Sub

• 删除图层

用Delete方法可以删除图层，但是，当前图层为0图层不能被删除，包含有对象的图层也不能被删除，只能删除空图层，语法格式：object.Delete。