×
INTELLIGENT WORK FORUMS
FOR ENGINEERING PROFESSIONALS

Log In

Come Join Us!

Are you an
Engineering professional?
Join Eng-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Eng-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Jobs

Changing attributes with VBA on multiple layouts

Changing attributes with VBA on multiple layouts

Changing attributes with VBA on multiple layouts

(OP)
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

RE: Changing attributes with VBA on multiple layouts

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"

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Eng-Tips Forums free from inappropriate posts.
The Eng-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Eng-Tips forums is a member-only feature.

Click Here to join Eng-Tips and talk with other members!


Resources