社区 › VBA/VB/ActiveX/API 编程技术 › AutoCAD VBA判断指定图层是否存在,如不存在则新建.

yshf 发表于 2012-11-15 22:35:47

本帖最后由 yshf 于 2012-11-15 22:45 编辑



Option Explicit
Dim oldLayer As AcadLayer
Dim NewLayer As AcadLayer

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

       ThisDrawing.ActiveLayer = ThisDrawing.Layers.Item("DIM")
   End Select
End Sub

Private Sub AcadDocument_EndCommand(ByVal CommandName As String)
    Select Case CommandName
    Case "DIMLINEAR", "DIMALIGNED", "DIMARC", "DIMORDINATE", "DIMRADIUS", "DIMJOGGED", "DIMDIAMETER", "DIMANGULAR", "QDIM", "DIMBASELINE", "DIMCONTINUE", "QLEADER"
      ThisDrawing.ActiveLayer = oldLayer
    End Select
End Sub

泉(Ango) 发表于 2012-11-18 15:15:40

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

yuanziyou 发表于 2014-11-16 21:25:18

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

查看完整版本: AutoCAD VBA判断指定图层是否存在,如不存在则新建.