社区 › VB › 如果图层存在，则：

hendie 发表于 2005-2-17 13:08:44

如果图层存在，则：

我正在开发一个模块，但我需要编写一个Errorhandler来处理与重复层相关的重复记录错误消息。
不幸的是，经过多次尝试，我无法编写足够的代码来检查图层集合以查看图层是否已经存在
有人碰巧有我可以借鉴的例子吗？
谢谢
Mark
**** Hidden Message *****

Anonymous 发表于 2005-2-17 13:31:51

你刚才有什么代码？
我不知道你说的
这是直接来自acad帮助的什么意思
Private Sub addlayer()
' This example creates a new layer called "New_Layer"
    Dim layerObj As AcadLayer
   
    ' Add the layer to the layers collection
    Set layerObj = ThisDrawing.Layers.Add("New_Layer")
   
    ' Make the new layer the active layer for the drawing
    ThisDrawing.ActiveLayer = layerObj
   
    ' Display the status of the new layer
   MsgBox layerObj.Name & " has been added." & vbCrLf & _
            "LayerOn Status: " & layerObj.LayerOn & vbCrLf & _
            "Freeze Status: " & layerObj.Freeze & vbCrLf & _
            "Lock Status: " & layerObj.Lock & vbCrLf & _
            "Color: " & layerObj.color, , "Add Example"
End Sub
你可以随意运行它，它不会生成错误消息

Anonymous 发表于 2005-2-17 13:35:24

嘿，Hendie
实际上，我没有任何与我的请求相关的内容可以发布。
如果您愿意，我可以告诉您我正在做什么，或者这是否会有帮助？
我希望有一段非常通用的代码，它将删除一个已经存在于我的新图层集合标记中的图层

Kerry 发表于 2005-2-17 13:45:20

意思是如果它存在于绘图中，不要尝试重新创建它？

Anonymous 发表于 2005-2-17 14:02:50

是的CmdrDuh
这正是我正在寻找的
如果层存在，那么不要尝试重新创建它
我需要完全
的代码标记

Kerry 发表于 2005-2-17 14:25:46

让我看看我有什么

Kerry 发表于 2005-2-17 14:58:17

像这样的

Option Explicit
Public Sub test()
    Dim bResult      As Boolean
    bResult = DoesLayerExist("XXX_001")
    If bResult Then
      MsgBox "Layer XXX_001 exists"
    Else
      MsgBox "Not Today Mark"
    End If
End Sub
Public Function DoesLayerExist(sLayer As String) As Boolean
    Dim oLayers      As AcadLayers
    Dim oLayer         As AcadLayer
    On Error GoTo Skippy
    Set oLayers = ThisDrawing.Layers
    Set oLayer = oLayers.Item(sLayer)
    DoesLayerExist = True
    Exit Function
Skippy:
   
End Function

Anonymous 发表于 2005-2-17 16:49:27

嘿，Kerry
我可以用你上面的代码来指定多个层吗？
我的绘图中大约有8-10个层，我希望VBA检查它们是否已经存在。
谢谢
马克

Anonymous 发表于 2005-2-17 16:52:45

谢谢Kerry，
谢谢CMD
对不起，我最近几次没有登录，所以我是以访客的身份发帖的。

Kerry 发表于 2005-2-17 18:04:35

这可能会给你一些想法，

Public Sub test_01()
    Dim bResult      As Boolean
    Dim svLayerList(0 To 9) As String
    Dim cnt            As Integer
    Dim sLayName       As String
    svLayerList(0) = "Layer0"
    svLayerList(1) = "0"
    svLayerList(2) = "Layer2"
    svLayerList(3) = "NoWay"
    svLayerList(4) = "Layer4"
    svLayerList(5) = "Layer5"
    svLayerList(6) = "Layer6"
    svLayerList(7) = "Layer7"
    svLayerList(8) = "Layer8"
    svLayerList(9) = "Bogus"
    For cnt = 0 To UBound(svLayerList)
      sLayName = svLayerList(cnt)
      bResult = DoesLayerExist(sLayName)
      
      If bResult Then
            MsgBox "Layer : " & sLayName & vbCrLf & " exists"
      Else
            MsgBox "Layer : " & sLayName & vbCrLf & " does NOT exist"
      End If
    Next
End Sub
Public Function DoesLayerExist(sLayer As String) As Boolean
    Dim oLayers      As AcadLayers
    Dim oLayer         As AcadLayer
   
    On Error Resume Next
    Set oLayers = ThisDrawing.Layers
    Set oLayer = oLayers.Item(sLayer)
    DoesLayerExist = (Err.Number = 0)
    Err.Clear
End Function

查看完整版本: 如果图层存在，则：