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

mccad

以下程序使用了事件以便自动执行，在制图时如果用户新建图层，则程序会自动提示用户是否将刚新建的图层设置为当前层。方便有些用户的制图习惯：

2. Option Explicit
3. Dim LayerCount As Integer
4. '图层设置开始前调用GetLayerCount过程
5. Private Sub AcadDocument_BeginCommand(ByVal CommandName As String)
6.   If CommandName = "LAYER" Or CommandName = "-LAYER" Then
7.     Call GetLayerCount
8.   End If
9. End Sub
10. '图层设置结束后调用SetLayerCurrent过程
11. Private Sub AcadDocument_EndCommand(ByVal CommandName As String)
12.   If CommandName = "LAYER" Or CommandName = "-LAYER" Then
13.     Call SetLayerCurrent
14.   End If
15. End Sub
16. '将当前图层数量保存到一个变量中
17. Private Sub GetLayerCount()
18.   LayerCount = ThisDrawing.Layers.Count
19. End Sub
20. '比较图层设置前后的图层数量，如果增加，则提示是否将新增的图层设置为当前层
21. Private Sub SetLayerCurrent()
22.   Dim LastLayerName As String
23.   Dim Lastlayer As AcadLayer
24.   Dim SetCutLayer As Integer
25.   If ThisDrawing.Layers.Count > LayerCount Then
26.     Set Lastlayer = ThisDrawing.Layers(ThisDrawing.Layers.Count - 1)
27.     LastLayerName = Lastlayer.Name
28.     SetCutLayer = MsgBox("是否将刚新建的“" & LastLayerName & "”图层设置为当前层？", _ vbOKCancel, "设置当前层")
29.     If SetCutLayer = vbOK Then
30.       ThisDrawing.ActiveLayer = Lastlayer
31.     End If
32.   End If
33. End Sub

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

好程序！非常实用！

Tiptoe

的确！向版主学习

wsccmm

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

fubinary

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