Attribute info?

[Anonymous]

I have drawings that have blocks called "PSPTB" (in modelspace as well as paperspace in any layout) which has attribute tags called "SHEET". How do I access these blocks and get the information from the "SHEET" tag for each block.
ie if the "PSPTB" blocks' "SHEET" tags' text value is "E2.01" how do I get this?

[Anonymous]

Hi Gary,
This is the method that I just learned this week.

Dim acaBlockRef As AcadBlockReference
Dim intCount As Integer
Dim varAttributes As Variant
Do
Set acaBlockRef = ThisDrawing.ModelSpace.Item(intCount)
intCount = intCount + 1
Loop Until acaBlockRef.Name = "PSPTB"
varAttributes = acaBlockRef.GetAttributes

Dim I As Integer
Dim strAnswer as String
For I = LBound(varAttributes) To UBound(varAttributes)
If varAttributes(I).TagString = "SHEET" Then
strAnswer = varAttributes(I).TextString
End If
Next

This example is for Modelspace. I just started learning
VBA last month but this code worked for me. Others with
more experience may be able to tell you how to look
in paperspace and modelspace at the same time.
Regards,
Kevin

[Anonymous]

I was pleased to find your code, while I can use it for myself as well. Can you tell me how to change the tagstring in the block to another name? I need to replace one specific attribute in more than 6000 drawings, so this routine can help me very much.

[Anonymous]

Hi Kevin,
I try to use this program but its giving me a error of Invalid prodedure call or argument, Set acaBlockRef = ThisDrawing.ModelSpace.Item(intCount) in this line please let me know whats wrong.
Public Sub TAGSTR()
Dim acaBlockRef As AcadBlockReference
Dim intCount As Integer
Dim varAttributes As Variant
Do
Set acaBlockRef = ThisDrawing.ModelSpace.Item(intCount)
intCount = intCount + 1
Loop Until acaBlockRef.Name = "SEATS"
varAttributes = acaBlockRef.GetAttributes

Dim I As Integer
Dim strAnswer As String
For I = LBound(varAttributes) To UBound(varAttributes)
If varAttributes(I).TagString = "SEAT#" Then
strAnswer = varAttributes(I).TextString
End If
Next
End Sub

Regards

Ashok

[Anonymous]

Ashok, Not that I was any help yesterday, but you might want to start with the sample in the help menu. Full program on Attributes to cut and paste, once you understand modify to your needs. Paul "ashokp" wrote in message news:24673439.1111665328698.JavaMail.jive@jiveforum1.autodesk.com... > Hi Kevin, > I try to use this program but its giving me a error of Invalid prodedure > call or argument, Set acaBlockRef = ThisDrawing.ModelSpace.Item(intCount) > in this line please let me know whats wrong. > Public Sub TAGSTR() > Dim acaBlockRef As AcadBlockReference > Dim intCount As Integer > Dim varAttributes As Variant > Do > Set acaBlockRef = ThisDrawing.ModelSpace.Item(intCount) > intCount = intCount + 1 > Loop Until acaBlockRef.Name = "SEATS" > varAttributes = acaBlockRef.GetAttributes > > Dim I As Integer > Dim strAnswer As String > For I = LBound(varAttributes) To UBound(varAttributes) > If varAttributes(I).TagString = "SEAT#" Then > strAnswer = varAttributes(I).TextString > End If > Next > End Sub > > Regards > > Ashok

[Anonymous]

Gary,
This will help you iterate thru all you blocks and modify the tag



[code]
Public Sub UPDATE_TB_of_sheet()
Dim oSS As AcadSelectionSet
Dim oBlkRef As AcadBlockReference
Dim vTB_Attribues As Variant
Dim i As Integer
Dim grpCode(0 To 1) As Integer
Dim dataVal(0 To 1) As Variant


' Build a selection set of group codes and values to filter for: Text or Mtext.
grpCode(0) = 0
dataVal(0) = "INSERT"
grpCode(1) = 2
dataVal(1) = "ODS_TB" '<-block name to search for

Set oSS = BuildSelectionSet("get 'em", grpCode, dataVal, True)


For Each oBlkRef In oSS
If UCase(oBlkRef.Name) = "ODS_TB" Then
vTB_Attribues = oBlkRef.GetAttributes
For i = LBound(vTB_Attribues) To UBound(vTB_Attribues)
If vTB_Attribues(i).TagString = "OF_SHEET" Then
vTB_Attribues(i).TextString = "11"
End If
Next
End If
Next


End Sub

'return a selection set
Public Function BuildSelectionSet(strPrompt As String, vGroupCode As Variant, vDataValues As Variant, Optional bSelectAll As Boolean = False) As AcadSelectionSet
Dim ssetObj As AcadSelectionSet

'create a new selection set object
Set ssetObj = vbdPowerSet("SS01")

If strPrompt <> vbNullString Then
ThisDrawing.Utility.Prompt strPrompt
AcadApplication.Update
End If

If Not IsEmpty(vGroupCode) Then
' choice between selecting onscreen and selecting all
If bSelectAll = True Then
ssetObj.Select acSelectionSetAll, , , vGroupCode, vDataValues
Else
ssetObj.SelectOnScreen vGroupCode, vDataValues
End If

Else
ssetObj.SelectOnScreen
End If

Set BuildSelectionSet = ssetObj

End Function



'Simple sel set object creation function.
'vba will return an error if the sel set object already exists
'in the SSETS collection
Public Function vbdPowerSet(strName As String) As AcadSelectionSet
Dim objSelSet As AcadSelectionSet
Dim objSelCol As AcadSelectionSets
Set objSelCol = ThisDrawing.SelectionSets
For Each objSelSet In objSelCol
If objSelSet.Name = strName Then
objSelCol.Item(strName).Delete
Exit For
End If
Next
Set objSelSet = objSelCol.Add(strName)
Set vbdPowerSet = objSelSet
End Function
[/code]