Changing attributes with VBA on multiple layouts

[jrice174]

At the end of a program where I make a lot of details in ModelSpace, I create a layout tab for each set of details. The new layout tabs are "Sheet1", "Sheet2", etc. I then insert a title block with attributes into each layout. I then need to go back and add the SheetNo attribute (ie."1 OF 10", "2 OF 10"...) to each title block.

I just want to select the blocks on each layout tab. As you can see, my filter doesn't do that. Also, the AddSheetNumbers part of the program puts the same sheet number data in all of the layouts title blocks. Can you help?

Here is the code.

intCodes(0) = -4: varCodeValues(0) = "<AND"
intCodes(1) = 0: varCodeValues(1) = "BLOCK"
intCodes(2) = -4: varCodeValues(2) = "<OR"
intCodes(3) = 8: varCodeValues(3) = "TEXT"
intCodes(4) = -4: varCodeValues(4) = "OR>"
intCodes(5) = 67: varCodeValues(5) = "0"
intCodes(6) = -4: varCodeValues(6) = "AND>"


Public Sub AddSheetNumbers()
For Each objLayout In ThisDrawing.Layouts
ThisDrawing.ActiveLayout = objLayout
If Left$(objLayout.Name, 5) = "Sheet" Then
Newlayout = objLayout.Name
I = Len(Newlayout)
On Error Resume Next
ThisDrawing.SelectionSets("TEMP").Delete
Set objSS = ThisDrawing.SelectionSets.Add("TEMP")
objSS.Select 5, Pt2, Pt1, intCodes, varCodeValues
For Each objBlockRef In objSS
If objBlockRef.Name = "TitleBlock" Then
For Each varAttribute In objBlockRef.GetAttributes
Select Case varAttribute.TagString
Case "SheetNo":
varAttribute.TextString = Right$(Newlayout, I - 5) & " OF " & Int((DetNo + 2) / 2)
End Select
Next varAttribute
End If
Next objBlockRef
End If
Next objLayout
End Sub

 

[borgunit]

There are a few approaches. We do a similar thing. What I do is first set the layout names by cycling through them and correcting them by their "AcadLayout.TabOrder". Then I make a selection set of all the title blocks (I do that by filtering by their names). Once I have them I can toggle through each one and check which layout it is on (with the following code)...

Public Function GetObjectLayoutName(ByRef acObj As AcadEntity) As String
'------------------------------------------------------------------------------
'GetobjectLayoutName:
'Arguments: Autocad object
'Returns: string eg "Model" or "Layout1" or "Layout2" etc...
'------------------------------------------------------------------------------
Dim acLayout As AcadLayout
'''''''''''''''''''''''''''''''''''''''
For Each acLayout In ThisDrawing.Layouts
If acObj.OwnerID = acLayout.Block.ObjectID Then
Set GetLayoutName = acLayout.Name
Exit Function
End If
Next

End Function

And from there I set the attributes in the title. I hope this is a help.

http://mechcad-insider.blogspot.com/

"The fear of the Lord is the beginning of wisdom"