乐筑天下

搜索
欢迎各位开发者和用户入驻本平台 尊重版权,从我做起,拒绝盗版,拒绝倒卖 签到、发布资源、邀请好友注册,可以获得银币 请注意保管好自己的密码,避免账户资金被盗
查看: 272|回复: 13

如果图层存在,则:

[复制链接]

18

主题

222

帖子

51

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
260
发表于 2005-2-17 13:08:44 | 显示全部楼层 |阅读模式
我正在开发一个模块,但我需要编写一个Errorhandler来处理与重复层相关的重复记录错误消息。
不幸的是,经过多次尝试,我无法编写足够的代码来检查图层集合以查看图层是否已经存在
有人碰巧有我可以借鉴的例子吗?
谢谢
Mark

本帖以下内容被隐藏保护;需要你回复后,才能看到!

游客,如果您要查看本帖隐藏内容请回复
回复

使用道具 举报

1

主题

21

帖子

2

银币

初来乍到

Rank: 1

铜币
25
发表于 2005-2-17 13:31:51 | 显示全部楼层
你刚才有什么代码?
我不知道你说的
这是直接来自acad帮助的什么意思
  1. Private Sub addlayer()
  2. ' This example creates a new layer called "New_Layer"
  3.     Dim layerObj As AcadLayer
  4.    
  5.     ' Add the layer to the layers collection
  6.     Set layerObj = ThisDrawing.Layers.Add("New_Layer")
  7.    
  8.     ' Make the new layer the active layer for the drawing
  9.     ThisDrawing.ActiveLayer = layerObj
  10.    
  11.     ' Display the status of the new layer
  12.      MsgBox layerObj.Name & " has been added." & vbCrLf & _
  13.             "LayerOn Status: " & layerObj.LayerOn & vbCrLf & _
  14.             "Freeze Status: " & layerObj.Freeze & vbCrLf & _
  15.             "Lock Status: " & layerObj.Lock & vbCrLf & _
  16.             "Color: " & layerObj.color, , "Add Example"
  17. End Sub

你可以随意运行它,它不会生成错误消息
回复

使用道具 举报

1

主题

21

帖子

2

银币

初来乍到

Rank: 1

铜币
25
发表于 2005-2-17 13:35:24 | 显示全部楼层
嘿,Hendie
实际上,我没有任何与我的请求相关的内容可以发布。
如果您愿意,我可以告诉您我正在做什么,或者这是否会有帮助?
我希望有一段非常通用的代码,它将删除一个已经存在于我的新图层集合标记中的图层
回复

使用道具 举报

116

主题

996

帖子

9

银币

顶梁支柱

Rank: 50Rank: 50

铜币
1466
发表于 2005-2-17 13:45:20 | 显示全部楼层

意思是如果它存在于绘图中,不要尝试重新创建它?
回复

使用道具 举报

1

主题

21

帖子

2

银币

初来乍到

Rank: 1

铜币
25
发表于 2005-2-17 14:02:50 | 显示全部楼层
是的CmdrDuh
这正是我正在寻找的
如果层存在,那么不要尝试重新创建它
我需要完全
的代码标记
回复

使用道具 举报

116

主题

996

帖子

9

银币

顶梁支柱

Rank: 50Rank: 50

铜币
1466
发表于 2005-2-17 14:25:46 | 显示全部楼层
让我看看我有什么
回复

使用道具 举报

116

主题

996

帖子

9

银币

顶梁支柱

Rank: 50Rank: 50

铜币
1466
发表于 2005-2-17 14:58:17 | 显示全部楼层
像这样的
  1. Option Explicit
  2. Public Sub test()
  3.     Dim bResult        As Boolean
  4.     bResult = DoesLayerExist("XXX_001")
  5.     If bResult Then
  6.         MsgBox "Layer XXX_001 exists"
  7.     Else
  8.         MsgBox "Not Today Mark"
  9.     End If
  10. End Sub
  11. Public Function DoesLayerExist(sLayer As String) As Boolean
  12.     Dim oLayers        As AcadLayers
  13.     Dim oLayer         As AcadLayer
  14.     On Error GoTo Skippy
  15.     Set oLayers = ThisDrawing.Layers
  16.     Set oLayer = oLayers.Item(sLayer)
  17.     DoesLayerExist = True
  18.     Exit Function
  19. Skippy:
  20.    
  21. End Function

回复

使用道具 举报

1

主题

21

帖子

2

银币

初来乍到

Rank: 1

铜币
25
发表于 2005-2-17 16:49:27 | 显示全部楼层
嘿,Kerry
我可以用你上面的代码来指定多个层吗?
我的绘图中大约有8-10个层,我希望VBA检查它们是否已经存在。
谢谢
马克
回复

使用道具 举报

1

主题

21

帖子

2

银币

初来乍到

Rank: 1

铜币
25
发表于 2005-2-17 16:52:45 | 显示全部楼层
谢谢Kerry,
谢谢CMD
对不起,我最近几次没有登录,所以我是以访客的身份发帖的。
回复

使用道具 举报

116

主题

996

帖子

9

银币

顶梁支柱

Rank: 50Rank: 50

铜币
1466
发表于 2005-2-17 18:04:35 | 显示全部楼层
这可能会给你一些想法,
  1. Public Sub test_01()
  2.     Dim bResult        As Boolean
  3.     Dim svLayerList(0 To 9) As String
  4.     Dim cnt            As Integer
  5.     Dim sLayName       As String
  6.     svLayerList(0) = "Layer0"
  7.     svLayerList(1) = "0"
  8.     svLayerList(2) = "Layer2"
  9.     svLayerList(3) = "NoWay"
  10.     svLayerList(4) = "Layer4"
  11.     svLayerList(5) = "Layer5"
  12.     svLayerList(6) = "Layer6"
  13.     svLayerList(7) = "Layer7"
  14.     svLayerList(8) = "Layer8"
  15.     svLayerList(9) = "Bogus"
  16.     For cnt = 0 To UBound(svLayerList)
  17.         sLayName = svLayerList(cnt)
  18.         bResult = DoesLayerExist(sLayName)
  19.         
  20.         If bResult Then
  21.             MsgBox "Layer : " & sLayName & vbCrLf & " exists"
  22.         Else
  23.             MsgBox "Layer : " & sLayName & vbCrLf & " does NOT exist"
  24.         End If
  25.     Next
  26. End Sub
  27. Public Function DoesLayerExist(sLayer As String) As Boolean
  28.     Dim oLayers        As AcadLayers
  29.     Dim oLayer         As AcadLayer
  30.    
  31.     On Error Resume Next
  32.     Set oLayers = ThisDrawing.Layers
  33.     Set oLayer = oLayers.Item(sLayer)
  34.     DoesLayerExist = (Err.Number = 0)
  35.     Err.Clear
  36. End Function

回复

使用道具 举报

发表回复

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁体中文

GMT+8, 2025-3-18 00:12 , Processed in 0.330567 second(s), 71 queries .

© 2020-2025 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表