AutoCAD VBA判断指定图层是否存在,如不存在则新建.

yshf

2. 
   
3. 
   
4. Option Explicit
   
5. Dim oldLayer As AcadLayer
   
6. Dim NewLayer As AcadLayer
   
7. 
   
8. Private Sub AcadDocument_BeginCommand(ByVal CommandName As String)
   
9.    Debug.Print CommandName
   
10.    Select Case CommandName
    
11.    Case "DIMLINEAR", "DIMALIGNED", "DIMARC", "DIMORDINATE", "DIMRADIUS", "DIMJOGGED", "DIMDIAMETER", "DIMANGULAR", "QDIM", "DIMBASELINE", "DIMCONTINUE", "QLEADER"
    
12.        Set oldLayer = ThisDrawing.ActiveLayer
    
13.    
    
14.       On Error Resume Next
    
15.        Set NewLayer = ThisDrawing.Layers("DIM")
    
16.        If Err Then
    
17.           Err.Clear
    
18.           Set NewLayer = ThisDrawing.Layers.Add("DIM")
    
19.        End If
    
20. 
    
21.        ThisDrawing.ActiveLayer = ThisDrawing.Layers.Item("DIM")
    
22.    End Select
    
23. End Sub
    
24. 
    
25. Private Sub AcadDocument_EndCommand(ByVal CommandName As String)
    
26.     Select Case CommandName
    
27.     Case "DIMLINEAR", "DIMALIGNED", "DIMARC", "DIMORDINATE", "DIMRADIUS", "DIMJOGGED", "DIMDIAMETER", "DIMANGULAR", "QDIM", "DIMBASELINE", "DIMCONTINUE", "QLEADER"
    
28.         ThisDrawing.ActiveLayer = oldLayer
    
29.     End Select
    
30. End Sub
    

<br /> <br /> Option Explicit<br /> Dim oldLayer As AcadLayer<br /> Dim NewLayer As AcadLayer<br /> <br /> Private Sub AcadDocument_BeginCommand(ByVal CommandName As String)<br />    Debug.Print CommandName<br />    Select Case CommandName<br />    Case "DIMLINEAR", "DIMALIGNED", "DIMARC", "DIMORDINATE", "DIMRADIUS", "DIMJOGGED", "DIMDIAMETER", "DIMANGULAR", "QDIM", "DIMBASELINE", "DIMCONTINUE", "QLEADER"<br />        Set oldLayer = ThisDrawing.ActiveLayer<br />     <br />       On Error Resume Next<br />        Set NewLayer = ThisDrawing.Layers("DIM")<br />        If Err Then<br />           Err.Clear<br />           Set NewLayer = ThisDrawing.Layers.Add("DIM")<br />        End If<br /> <br />        ThisDrawing.ActiveLayer = ThisDrawing.Layers.Item("DIM")<br />    End Select<br /> End Sub<br /> <br /> Private Sub AcadDocument_EndCommand(ByVal CommandName As String)<br />     Select Case CommandName<br />     Case "DIMLINEAR", "DIMALIGNED", "DIMARC", "DIMORDINATE", "DIMRADIUS", "DIMJOGGED", "DIMDIAMETER", "DIMANGULAR", "QDIM", "DIMBASELINE", "DIMCONTINUE", "QLEADER"<br />         ThisDrawing.ActiveLayer = oldLayer<br />     End Select<br /> End Sub<br />

泉(Ango)

谢谢大家的帮助......

yuanziyou

好像不管是否存在Dim图层,直接新建Dim图层并置为当前图层也不会出问题吧
像这样:
ThisDrawing.ActiveLayer = ThisDrawing.Layers.Add("Dim")