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。