社区 › VBA/VB/ActiveX/API 编程技术 › 将新建图层自动设置为当前层的程序

mccad 发表于 2003-9-1 21:42:00

将新建图层自动设置为当前层的程序

本帖最后由 作者 于 2010-8-10 22:11:16 编辑

以下程序使用了事件以便自动执行，在制图时如果用户新建图层，则程序会自动提示用户是否将刚新建的图层设置为当前层。方便有些用户的制图习惯：
Option Explicit
Dim LayerCount As Integer
'图层设置开始前调用GetLayerCount过程
Private Sub AcadDocument_BeginCommand(ByVal CommandName As String)
If CommandName = "LAYER" Or CommandName = "-LAYER" Then
    Call GetLayerCount
End If
End Sub
'图层设置结束后调用SetLayerCurrent过程
Private Sub AcadDocument_EndCommand(ByVal CommandName As String)
If CommandName = "LAYER" Or CommandName = "-LAYER" Then
    Call SetLayerCurrent
End If
End Sub
'将当前图层数量保存到一个变量中
Private Sub GetLayerCount()
LayerCount = ThisDrawing.Layers.Count
End Sub
'比较图层设置前后的图层数量，如果增加，则提示是否将新增的图层设置为当前层
Private Sub SetLayerCurrent()
Dim LastLayerName As String
Dim Lastlayer As AcadLayer
Dim SetCutLayer As Integer
If ThisDrawing.Layers.Count > LayerCount Then
    Set Lastlayer = ThisDrawing.Layers(ThisDrawing.Layers.Count - 1)
    LastLayerName = Lastlayer.Name
    SetCutLayer = MsgBox("是否将刚新建的“" & LastLayerName & "”图层设置为当前层？", _ vbOKCancel, "设置当前层")
    If SetCutLayer = vbOK Then
      ThisDrawing.ActiveLayer = Lastlayer
    End If
End If
End Sub

gzy 发表于 2003-10-3 16:37:00

好程序！非常实用！

Tiptoe 发表于 2003-10-6 23:20:00

的确！向版主学习

wsccmm 发表于 2010-8-10 12:26:00

多谢啊，我正在为如何使用新建的图层发愁呢。

fubinary 发表于 2013-9-18 08:02:41

看看是使用什么方法。学习学习。

查看完整版本: 将新建图层自动设置为当前层的程序