Attribute Question - VB6

[simplytar]

Hello,

I am a VB newby. Below is a snippet of my program written in VB6, in which I need to
capture the attributes from a block that I know the name of: the block's name
is "TRACKER". I know how to capture the attributes with user input (as shown below),
but I need to capture the attributes with NO user input: ie, no picking the block.
I am looping through numerous drawings to update this block
using VB6 and Acad 2002. I have read through numerous postings and help
files and have not seen such an example - ie: with no user input.

Any help would be appreciated.

Thanks,
Todd-


Public Sub UpdateTrackingInfo()

'Open drawing to process - I am actually looping through multiple drawings and
'processing them - no problem here.
objThisDrawing.Open List2.List(ii)


'Variables for the Block, Attributes and picked point
Dim CurrBlk As AcadBlockReference
Dim CurrAtts As Variant
Dim pt As Variant

'Variables For the Loop Only
Dim strAttributes As String
Dim I As Integer

'Hide the form
frmAutoAtt.Hide

'Max the drawing window
objThisDrawing.WindowState = acMax

'Max the AutoCAD application
objThisDrawing.Application.WindowState = acMax

'Make AutoCAD active
AppActivate "Autocad"

'Pick the block you want to display attributes for
objThisDrawing.Utility.GetEntity CurrBlk, pt, "Pick a Block to display information..."

'THE ABOVE LINE IS WHERE MY ISSUE IS... I DON'T WANT TO PICK THE
'BLOCK. I KNOW THE NAME OF THE BLOOCK - It's NAME IS "TRACKER".
'I JUST WANT TO CAPTURE THE ATTRIBUTES IN "TRACKER" WITHOUT
'ANY USER INPUT.


'Move the attributes from the block to the Variant
CurrAtts = CurrBlk.GetAttributes

'Clear the variable
strAttributes = ""

'Move the attribute tags and values into an array
For I = LBound(CurrAtts) To UBound(CurrAtts)
strAttributes = strAttributes + "Tag: " + CurrAtts(I).TagString + " Value: " + CurrAtts(I).TextString + vbCrLf
Next

'Minimize AutoCAD
objThisDrawing.Application.WindowState = acMin

'Display the Atts and values in a msgbox
MsgBox "The Name of the Block you selected is: " + CurrBlk.Name + "." & vbCrLf + _
"It has the Following Attribute Tags and Values:" & _
vbCrLf & strAttributes

'Show the Attribute form
frmAutoAtt.Show

[RobertAitken]

Did anyone get back to you on this?

If not try and create a selection set to seect just your block then iterate through the attributes. No user input required.

Robert Aitken

[mtuersley]

Here's an example of how to do it. This example was pulled from a late-binding project which is why a couple of the variables are declared as Objects. Also, it requires g_cadDoc to be set to the current active document. Its fairly straight forward so I'm sure you can decipher it....


Function PullAtt(sBLName As String, sAttTag As String) As String
'+--Function receives a block name and attribute string and returns the
' value of that attribute
Dim iCode(0 To 1) As Integer
Dim vValue(0 To 1) As Variant
Dim ssObjects As Object '''AcadSelectionSet
Dim oCurIns As Object '''AcadBlockReference
Dim vAttList As Variant
Dim iAttCnt As Integer
Dim sTemp As String
'Set filtering values
iCode(0) = 0
iCode(1) = 2
vValue(0) = "INSERT"
vValue(1) = sBLName
'preset return value
PullAtt = vbnullstring
On Error Resume Next
'Select block reference with name sBLName
Set ssObjects = g_cadDoc.SelectionSets.Add("ssBlkRefs")
If Err.Number <> 0 Then
Err.Clear
g_cadDoc.SelectionSets("ssBlkRefs").Delete
Set ssObjects = g_cadDoc.SelectionSets.Add("ssBlkRefs")
End If
On Error GoTo Error_Control
ssObjects.Select acSelectionSetAll, , , iCode, vValue
'Find the right block reference
If ssObjects.Count > 0 Then
For Each objCurIns In ssObjects
sTemp = g_cadDoc.ObjectIdToObject(objCurIns.OwnerID).Layout.Name
If sTemp = g_cadDoc.ActiveLayout.Name Then Exit For
Next
Else
'No block found
Debug.Print "Block not found"
Goto Exit_Here:
End If
'Get all attributes within blockref
vAttList = oCurIns.GetAttributes
'Iterate thru them looking for the desired attribute tag
For iAttCnt = LBound(vAttList) To UBound(vAttList)
If UCase(vAttList(iAttCnt).TagString) = UCase(sAttTag) Then
'Found it so set the return value and leave
PullAtt = vAttList(iAttCnt).TextString
Exit For
End If
Next

Exit_Here:
If Not ssObjects Is Nothing Then Set ssObjects = Nothing
If Not oCurIns Is Nothing Then Set oCurIns = Nothing
Exit Function

Error_Control:
Select Case Err.Number
Case -2147024809 'Block doesn't exist
Debug.Print "Block not found"
Case Else 'All other errors
Debug.Print Err.Description
End Select
Err.Clear
Resume Exit_Here
End Function