| Author |
Message |
simplytar
Guest
|
 Posted:
Fri Jan 14, 2005 5:39 pm Post subject:
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
|
|
| Back to top |
|
 |
Jackrabbit
Guest
|
| Posted:
Fri Jan 14, 2005 8:16 pm Post subject:
Re: Just another Attribute Question - VB6 |
|
|
| 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
'------------------------------------------------------------------------------
|
|
|
| Back to top |
|
|
hwalker
Guest
|
| Posted:
Fri Jan 14, 2005 8:17 pm Post subject:
Re: Just another Attribute Question - VB6 |
|
|
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.
|
|
| Back to top |
|
|
Bobby C. Jones
Guest
|
| Posted:
Fri Jan 14, 2005 9:15 pm Post subject:
Re: Just another Attribute Question - VB6 |
|
|
| Quote: | For Each SelectionSet In ThisDrawing.SelectionSets
If UCase(SelectionSet.Name) = "TRACKER" Then
SelectionSet.Delete
Exit For
End If
Next SelectionSet
|
Hey Jackrabbit,
The SelectionSets collections has an .Item method.
HTH
--
Bobby C. Jones |
|
| Back to top |
|
|
Jackrabbit
Guest
|
| Posted:
Fri Jan 14, 2005 9:55 pm Post subject:
Re: Just another Attribute Question - VB6 |
|
|
You mean like this?
On Error Resume Next
ThisDrawing.SelectionSets("TRACKER").Delete |
|
| Back to top |
|
|
simplytar
Guest
|
| Posted:
Fri Jan 14, 2005 10:27 pm Post subject:
Re: Just another Attribute Question - VB6 |
|
|
Thanks to all.
I works!!!
-Todd |
|
| Back to top |
|
|
Bobby C. Jones
Guest
|
| Posted:
Sat Jan 15, 2005 1:02 am Post subject:
Re: Just another Attribute Question - VB6 |
|
|
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>
--
Bobby C. Jones
"Jackrabbit" <nospam@address.withheld> wrote in message
news:32598568.1105721769921.JavaMail.jive@jiveforum2.autodesk.com...
| Quote: | You mean like this?
On Error Resume Next
ThisDrawing.SelectionSets("TRACKER").Delete |
|
|
| Back to top |
|
|
|
|
|
|
FAQ
Memberlist
Register
Profile
Log in to check your private messages
Log in