Just another Attribute Question - VB6

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 auto-magically
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

 

Code:

Option Explicit

'------------------------------------------------------------------------------

Public Sub ShowBlockInfo_Method_1()

Dim Attributes As Variant
Dim BlockRef As AcadBlockReference
Dim Entity As AcadEntity
Dim I As Integer
Dim Message As String

For Each Entity In ThisDrawing.PaperSpace
If TypeOf Entity Is AcadBlockReference Then
Set BlockRef = Entity
If BlockRef.Name = "TRACKER" Then
Message = "Block name: " & BlockRef.Name
Attributes = BlockRef.GetAttributes
For I = LBound(Attributes) To UBound(Attributes)
Message = Message & vbCrLf & Attributes(I).TagString & ": " & _
Attributes(I).TextString
Next I
MsgBox Message
End If
End If
Next Entity

End Sub

'------------------------------------------------------------------------------

Public Sub ShowBlockInfo_Method_2()

Dim Attributes As Variant

Dim BlockRef As AcadBlockReference
Dim FilterData(0 To 1) As Variant
Dim FilterType(0 To 1) As Integer
Dim I As Integer
Dim Message As String
Dim SelectionSet As AcadSelectionSet

For Each SelectionSet In ThisDrawing.SelectionSets
If UCase(SelectionSet.Name) = "TRACKER" Then
SelectionSet.Delete
Exit For
End If
Next SelectionSet

Set SelectionSet = ThisDrawing.SelectionSets.Add("TRACKER")
FilterData(0) = "INSERT"
FilterType(0) = 0
FilterData(1) = "TRACKER"
FilterType(1) = 2
SelectionSet.Select acSelectionSetAll, , , FilterType, FilterData
Debug.Print SelectionSet.Count

If SelectionSet.Count > 0 Then
For Each BlockRef In SelectionSet
Message = "Block name: " & BlockRef.Name
Attributes = BlockRef.GetAttributes
For I = LBound(Attributes) To UBound(Attributes)
Message = Message & vbCrLf & Attributes(I).TagString & ": " & _
Attributes(I).TextString
Next I
MsgBox Message
Next BlockRef
End If

End Sub

'------------------------------------------------------------------------------

 

Is your block always in the same place on each of your drawings? If it is, could you get your program to select the xy coordinates of your block. Just a suggestion.

 

For Each SelectionSet In ThisDrawing.SelectionSets

Hey Jackrabbit,
The SelectionSets collections has an .Item method.

HTH

 

You mean like this?

On Error Resume Next
ThisDrawing.SelectionSets("TRACKER").Delete

 

Thanks to all.

I works!!!

-Todd

 

I'd prefer that over coding a foreach loop every time I wanted to check for
an item in a collection, although this function demonstrates my "most"
preferred method.

Public Function CreateSelectionSet(Optional ssName As String = "ss") As
AcadSelectionSet

Dim ss As AcadSelectionSet

On Error Resume Next
Set ss = ThisDrawing.SelectionSets(ssName)
If Err Then Set ss = ThisDrawing.SelectionSets.Add(ssName)
ss.Clear
Set CreateSelectionSet = ss

End Function

Code c.o. Frank O. or Bob Bell, sorry guys I'm getting older and my memory
is going quick <g>