您的位置:网站首页 > CAD新闻

VB编程操作AtuoCAD图层

时间:2012-01-17 09:42:03 来源:未知

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

  • 创建并命名图层

新的图形文件建立时,系统自动创建一个名为”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。


相关文章