乐筑天下

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

错误图层上的块

[复制链接]

57

主题

235

帖子

3

银币

后起之秀

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

铜币
463
发表于 2006-11-1 17:57:19 | 显示全部楼层 |阅读模式
VBA-
好吧,我被不在零层的块和外部参照所迷惑。
如何收集Blocks集合,然后将所有块和外部参照放置在图层0上?

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

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

使用道具 举报

12

主题

64

帖子

3

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
112
发表于 2006-11-1 19:38:15 | 显示全部楼层

1。获取所有acadblockreference和acadexternalreference对象的选择集。
2。迭代选择集中的每个项目,将其图层设置为“0”。
  1. Public Sub BlocksAndXrefsToZeroLayer()
  2.     Dim oEnt As AcadEntity
  3.     Dim I As Integer
  4.     Dim oSS As AcadSelectionSet
  5.     Dim iType(3) As Integer
  6.     Dim vData(3) As Variant
  7.     Dim P1(2) As Double
  8.     Dim P2(2) As Double
  9.     Set oSS = getSS("zlayer")
  10.     iType(0) = -4: vData(0) = ""
  11.     oSS.Select acSelectionSetAll, P1, P2, iType, vData
  12.     If oSS.Count < 1 Then Exit Sub
  13.     For I = 0 To oSS.Count - 1
  14.         Set oEnt = oSS(I)
  15.         If ThisDrawing.Layers(oEnt.Layer).Lock Then
  16.             ' entity is on a locked layer - can't change it
  17.         Else
  18.             oEnt.Layer = "0"
  19.             oEnt.Update
  20.         End If
  21.     Next
  22. End Sub
  23. Public Function getSS(strName As String) As AcadSelectionSet
  24.     Dim SS As AcadSelectionSet
  25.     On Error Resume Next
  26.     ThisDrawing.SelectionSets(strName).Delete
  27.     Set SS = ThisDrawing.SelectionSets.Add(strName)
  28.     Set getSS = SS
  29. End Function

回复

使用道具 举报

57

主题

235

帖子

3

银币

后起之秀

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

铜币
463
发表于 2006-11-2 06:06:48 | 显示全部楼层
谢谢马克,我会试一试的。
回复

使用道具 举报

57

主题

235

帖子

3

银币

后起之秀

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

铜币
463
发表于 2006-11-2 12:47:35 | 显示全部楼层
马克,
梦幻般的代码!
谢谢!
回复

使用道具 举报

发表回复

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

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

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

GMT+8, 2025-7-6 21:04 , Processed in 0.347079 second(s), 61 queries .

© 2020-2025 乐筑天下

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