历遍多个布局求助

toosimple 发表于 2006-8-2 15:52:00

Option Explicit
Private Sub CommandButton1_Click() Dim layo As AcadLayout Dim sset As AcadSelectionSet Dim str1 As String Dim oldstr As String Dim newstr As String Dim ftype(0) As Integer Dim fdata(0) As Variant Dim point1(0 To 2) As Double Dim point2(0 To 2) As Double Dim i As Integer Dim abc As Object
ftype(0) = 0 fdata(0) = "TEXT" oldstr = "a" newstr = "e" point1(0) = 343 point1(1) = 272.5 point1(2) = 0 point2(0) = 403 point2(1) = 280 point2(2) = 0 UserForm1.Hide
'以下建立选择集 On Error Resume Next    If Not IsNull(ThisDrawing.SelectionSets.Item("ss1")) Then       Set sset = ThisDrawing.SelectionSets.Item("ss1")       sset.Delete    End If     Set sset = ThisDrawing.SelectionSets.Add("ss1")     sset.Clear '选择集建立完毕 '%%%%%%%%%%%%%%%%%之间的部分有问题 For i = 0 To ThisDrawing.Layouts.Count - 1 Step 1 Set abc = ThisDrawing.Layouts.Item(0)     sset.Clear     sset.Select acSelectionSetWindow, point1, point2, ftype, fdata     str1 = sset.Item(0).TextString     If InStr(str1, oldstr) Then        sset.Item(0).TextString = replacestr(str1, oldstr, newstr, False)'调用下面函数        'sset.Item(0).Update        ThisDrawing.Regen acAllViewports
    End If   Next i '%%%%%%%%%%%%%%%%%%%%%以上有问题 End Sub '以下函数执行替换========================================================================== Public Function replacestr(ByVal searchstr As String, ByVal oldstr As String, ByVal newstr As String, ByVal firstonly As Boolean) As String If searchstr = "" Then Exit Function If oldstr = "" Then Exit Function Dim i As Integer, oldstrlen As Integer, holdstr As String, strloc As Integer replacestr = "" oldstrlen = Len(oldstr) strloc = InStr(searchstr, oldstr) While strloc > 0       holdstr = holdstr & Left(searchstr, strloc - 1) & newstr       searchstr = Mid(searchstr, strloc + oldstrlen)       strloc = InStr(searchstr, oldstr)       If firstonly Then replacestr = holdstr & searchstr: Exit Function Wend replacestr = holdstr & searchstr End Function '===================================================
图形有2个布局，在每个布局中，在（３４３，２７２．５）与（４０３，２８０）范围内有一个text：内容为"hah"，我想把他变成"heh"，可是上面的程序只能对当前显示的布局有效，对其他布局没作用不知道为什么，麻烦各位给看看吧

fjfhgdwfn 发表于 2006-8-2 19:08:00

ThisDrawing.SetVariable "CTAB", Layout.Name
加上这一句,使他变成当前布局.

页: [1]

明经CAD社区's Archiver

历遍多个布局求助