乐筑天下

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

错误层上的块

[复制链接]

12

主题

64

帖子

3

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
112
发表于 2006-11-1 17:57:19 | 显示全部楼层 |阅读模式
VBA-
好的,我是由不在零层上的块和外部参照生成的
如何收集块集合,然后将所有块和外部参照放置在层0上?
回复

使用道具 举报

0

主题

9

帖子

5

银币

初来乍到

Rank: 1

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

获取所有acadblockreference和acadexternalreference对象的选择集。迭代选择集中的每个项目,将其层设置为;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

回复

使用道具 举报

0

主题

7

帖子

4

银币

初来乍到

Rank: 1

铜币
8
发表于 2006-11-2 06:06:48 | 显示全部楼层
谢谢马克,我&#039;我试试看。
回复

使用道具 举报

0

主题

12

帖子

3

银币

初来乍到

Rank: 1

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

使用道具 举报

发表回复

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

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

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

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

© 2020-2025 乐筑天下

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