乐筑天下

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

VBA如何得到具体哪个布局中的数据

[复制链接]

4

主题

7

帖子

2

银币

初来乍到

Rank: 1

铜币
23
发表于 2004-10-19 16:49:00 | 显示全部楼层 |阅读模式
For i = 0 To ThisDrawing.Layouts.Count                                                                                                                                                                 '在各布局各中循环
                                                 Set lay1 = ThisDrawing.Layouts.Item(i)
                                                 If lay1.Name  "model" Then
                                                                                         '         filterdata = "A" & (10 * i)
                                                                                                 ' On Error Resume Next
                                                                                                         lay1.Name = filterdata
                                                                                 '                 On Error Resume Next
                                                 End If
                         '         MsgBox lay1.Name                                                                                                                                                                                                 '得到所有布局的名称
Next
        sti = 0
        For j = 0 To ThisDrawing.PaperSpace.Count - 1                 '在当前图纸空间内循环
                                 Set a = ThisDrawing.PaperSpace.Item(j)
                                         If a.ObjectName = "AcDbText" Then
                                                                         st(sti) = a.TextString
                                                                                                         If st(sti) = "图号:1" Then
                                                                                                                                                         MsgBox st(sti)
                                                                                                                                                         st(sti) = "图号:2"                                                                 '替换字符串
                                                                                                                                                         a.TextString = st(sti)
                                                                                                                 End If
                                                                                 sti = sti + 1
                                         End If
        Next
我想把到如A0,A10,A20布局中的"图号:1"都替换成"图号:2"要如何做,请老大们指点下
我前面的程序只能一个个的改.
回复

使用道具 举报

34

主题

372

帖子

7

银币

中流砥柱

Rank: 25

铜币
508
发表于 2004-10-19 20:59:00 | 显示全部楼层
你要替换的文字是在模型空间还是图纸空间?
回复

使用道具 举报

4

主题

7

帖子

2

银币

初来乍到

Rank: 1

铜币
23
发表于 2004-10-20 08:39:00 | 显示全部楼层
是图纸空间
回复

使用道具 举报

34

主题

372

帖子

7

银币

中流砥柱

Rank: 25

铜币
508
发表于 2004-10-20 12:28:00 | 显示全部楼层
用选择集来操作吧,分别设置当前的布局为A0、A10等,然后选择符合条件的文字,并且进行替换。
回复

使用道具 举报

4

主题

7

帖子

2

银币

初来乍到

Rank: 1

铜币
23
发表于 2004-10-20 19:01:00 | 显示全部楼层
我就是不知如何用程序来设置,能写简单的VBA代码给我吗.
回复

使用道具 举报

158

主题

2315

帖子

10

银币

顶梁支柱

Rank: 50Rank: 50

铜币
2951
发表于 2004-10-20 19:11:00 | 显示全部楼层
用以下程序就可以得到所有布局中的文字:
  1. Public Sub BuildFilter(typeArray, dataArray, ParamArray gCodes())
  2.        Dim fType() As Integer, fData()
  3.        Dim index As Long, i As Long
  4.       
  5.        index = LBound(gCodes) - 1
  6.                
  7.        For i = LBound(gCodes) To UBound(gCodes) Step 2
  8.                index = index + 1
  9.                ReDim Preserve fType(0 To index)
  10.                ReDim Preserve fData(0 To index)
  11.                fType(index) = CInt(gCodes(i))
  12.                fData(index) = gCodes(i + 1)
  13.        Next
  14.        typeArray = fType: dataArray = fData
  15. End Sub
  16. Function CreateSelectionSet(Optional SSetName As String = "mjtd") As AcadSelectionSet
  17.        On Error Resume Next
  18.        ThisDrawing.SelectionSets(SSetName).Delete
  19.        Set CreateSelectionSet = ThisDrawing.SelectionSets.Add(SSetName)
  20. End Function
  21. Sub SelectAllLayoutText()
  22.        Dim ss As AcadSelectionSet
  23.        Set ss = CreateSelectionSet
  24.        Dim typeArray As Variant
  25.        Dim dataArray As Variant
  26.        BuildFilter typeArray, dataArray, 0, "TEXT"
  27.        ss.Select acSelectionSetAll, , , typeArray, dataArray
  28.        Debug.Print ss.Count
  29. End Sub
特别提示:Select 的 acSelectionSetAll 项所选择的是所有图形中的对象,不管对象是在哪个空间或布局中。
如果需要过滤出某个布局中的对象,则使用实用函数中的以下函数解决:
回复

使用道具 举报

4

主题

7

帖子

2

银币

初来乍到

Rank: 1

铜币
23
发表于 2004-10-21 10:23:00 | 显示全部楼层
非常感谢,可以用了
回复

使用道具 举报

发表回复

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

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

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

GMT+8, 2025-3-16 06:47 , Processed in 0.425669 second(s), 66 queries .

© 2020-2025 乐筑天下

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