adding info to an array (attn: Josh and Frank)

[Anonymous]

Josh and Frank,

    Thanx again for the help!  I have incororated the
code that you both gave me.

    For those that are interested in helping me, I am trying
to renumber a "roomtag" that contains one attribute value.  The block was
preinserted.

    I am still having some problems with certain parts of it
and was wondering if you could help me figure them out.  Below is the code
(with minor additions and changes in order for it to work with my stuff):

    I noted problems I was having with comments.  A lot
of this is going to look strange when you see it becuse I am geussing at most of
it.  I am sure that's part of the reason it does not work like it is
supposed to.

Caution:  It's pretty long.

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

Public Sub BuildFilter(typeArray, dataArray, ParamArray gCodes())

    Dim fType() As Integer, fData()
   
Dim index As Long, i As Long
   
    index
= LBound(gCodes) - 1
       

    For i = LBound(gCodes) To UBound(gCodes) Step
2
        index = index +
1
        ReDim Preserve fType(0 To
index)
        ReDim Preserve fData(0 To
index)
        fType(index) =
CInt(gCodes(i))
        fData(index) =
gCodes(i + 1)
    Next
    typeArray =
fType: dataArray = fData

End Sub

Private Sub cmdRun_Click()

Dim fType, fData, ss As AcadSelectionSet
Dim varblkAttribs As
Variant
Dim strblkAttribs As String
Dim blkRef As
AcadBlockReference
Dim objBlkSelect As AcadSelectionSet
Dim intarray() As
Integer
Dim attarry As AcadAttribute
Dim Point(0 To 2) As Double
Dim
strArray As String
Dim Acadblock As AcadBlockReference

With ThisDrawing.Utility

Set ss = CreateSelectionSet()
BuildFilter fType, fData, 0, "INSERT", 2,
"ROOMTAG"
ss.Select acSelectionSetAll, , , fType, fData
.Prompt vbCr &
"There are " & ss.Count & " Roomtags in this drawing. "

End With

If ss.Count > 0 Then
Do
Dim Ent As AcadEntity
Dim Pt As
Variant
Set Ent = Nothing

     On Error Resume Next
    
Me.Hide

'When using the "getentity" method to select the necessary blocks, I
have to select and then 'press enter (mouse or keyboard)  to get the
attribute value to change.  Is there a way to just go 'through and
select all necessary blocks and then have the attributes update?

     ThisDrawing.Utility.GetEntity Ent, Pt, "Select
the roomtags in order :"
    

     Ent.Highlight True
     If
Err Then
         If
ThisDrawing.GetVariable("errno") = "7"
Then
            
Err.Clear
        
Else
            
Err.Clear
            
Exit Do
         End
If
     End If

'As you mentioned, I could only get this if statement to work when I
used acadblockreference

'insetead od declraing a variable as an acadblockrefernce

     If TypeOf Ent Is AcadBlockReference
Then

'Here I had to set blkref = to Ent in order to get the code to
recogognize the Ent as a block

     Set blkRef =
Ent
            GoTo
EditAttrib
     Else
           
MsgBox "One of the objects selected is not a
Roomtag."
           
Ent.Highlight
False
            End
If
           

EditAttrib:

With ThisDrawing.Utility
    If blkRef.Name = "roomtag"
Then
        If blkRef.HasAttributes
Then
           
varblkAttribs =
blkRef.GetAttributes
       
    End If
        End
If
            For i =
LBound(varblkAttribs) To
UBound(varblkAttribs)
       
    strblkAttribs = strblkAttribs & " Tag(" & i & "):
" & _
           
varblkAttribs(i).tagString & vbTab & " value(" & i & "): " &
_
           
varblkAttribs(i).TextString & vbCr

'I could not get the ParsedPath or the PrevInstances statements to work
properly.  What exactly is 'ParsedPath anyway?  When used it just adds
1 to the number of all the roomtags that were 'selected in the drawing. So
in other words all of the roomtags end up being exactly the same.  I 'think
I am confused on the Array part.

           
varblkAttribs(0).TextString = txtStrtNum.Text & ParsedPath &
(PrevInstances + 1)

Next
       

Set GetEntity = Ent
End With
Ent.Highlight False
Loop

End If

End Sub

Thanx again for any help that anyone can provide.

Rob

[Anonymous]

Hi Rob,
First off, you can ditch the previous instances and parsed path
segments. The snip of code I gave you was from one of my macros and
wasn't tailored to your app. I posted it as an example. One of the
customer title blocks we use requires the drawing path a "-" in place of
each "\". In addition, they want all the Assembly drawings in one dwg
file, and the last digit in the string is the sheet number.,,,,,, Don't
ask 🙂 Anyway, just replace:
varblkAttribs(0).TextString = txtStrtNum.Text & ParsedPath &
(PrevInstances + 1)
with:
varblkAttribs(0).TextString = txtStrtNum.Text

and see where that gets you. I'll take a closer look in a bit and let
you know what I come up with.
-Josh

Rob Outman wrote:

> Josh and Frank, Thanx again for the help! I have incororated the
> code that you both gave me. For those that are interested in
> helping me, I am trying to renumber a "roomtag" that contains one
> attribute value. The block was preinserted. I am still having
> some problems with certain parts of it and was wondering if you could
> help me figure them out. Below is the code (with minor additions and
> changes in order for it to work with my stuff): I noted problems I
> was having with comments. A lot of this is going to look strange when
> you see it becuse I am geussing at most of it. I am sure that's part
> of the reason it does not work like it is supposed to. Caution: It's
> pretty long. 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 Public Sub
> BuildFilter(typeArray, dataArray, ParamArray gCodes()) Dim fType()
> As Integer, fData()
> Dim index As Long, i As Long
>
> index = LBound(gCodes) - 1
>
> For i = LBound(gCodes) To UBound(gCodes) Step 2
> index = index + 1
> ReDim Preserve fType(0 To index)
> ReDim Preserve fData(0 To index)
> fType(index) = CInt(gCodes(i))
> fData(index) = gCodes(i + 1)
> Next
> typeArray = fType: dataArray = fData End Sub
> Private Sub cmdRun_Click() Dim fType, fData, ss As AcadSelectionSet
> Dim varblkAttribs As Variant
> Dim strblkAttribs As String
> Dim blkRef As AcadBlockReference
> Dim objBlkSelect As AcadSelectionSet
> Dim intarray() As Integer
> Dim attarry As AcadAttribute
> Dim Point(0 To 2) As Double
> Dim strArray As String
> Dim Acadblock As AcadBlockReference With ThisDrawing.Utility Set ss =
> CreateSelectionSet()
> BuildFilter fType, fData, 0, "INSERT", 2, "ROOMTAG"
> ss.Select acSelectionSetAll, , , fType, fData
> .Prompt vbCr & "There are " & ss.Count & " Roomtags in this drawing.
> " End With If ss.Count > 0 Then
> Do
> Dim Ent As AcadEntity
> Dim Pt As Variant
> Set Ent = Nothing On Error Resume Next
> Me.Hide 'When using the "getentity" method to select the
> necessary blocks, I have to select and then 'press enter (mouse or
> keyboard) to get the attribute value to change. Is there a way to
> just go 'through and select all necessary blocks and then have the
> attributes update?
> ThisDrawing.Utility.GetEntity Ent, Pt, "Select the roomtags in
> order :"
>
> Ent.Highlight True
> If Err Then
> If ThisDrawing.GetVariable("errno") = "7" Then
> Err.Clear
> Else
> Err.Clear
> Exit Do
> End If
> End If 'As you mentioned, I could only get this if statement to
> work when I used acadblockreference'insetead od declraing a variable
> as an acadblockrefernce
> If TypeOf Ent Is AcadBlockReference Then 'Here I had to set
> blkref = to Ent in order to get the code to recogognize the Ent as a
> block
> Set blkRef = Ent
> GoTo EditAttrib
> Else
> MsgBox "One of the objects selected is not a Roomtag."
> Ent.Highlight False
> End If
> EditAttrib: With ThisDrawing.Utility
> If blkRef.Name = "roomtag" Then
> If blkRef.HasAttributes Then
> varblkAttribs = blkRef.GetAttributes
> End If
> End If
> For i = LBound(varblkAttribs) To UBound(varblkAttribs)
> strblkAttribs = strblkAttribs & " Tag(" & i & "): " & _
> varblkAttribs(i).tagString & vbTab & " value(" & i & "): "
> & _
> varblkAttribs(i).TextString & vbCr 'I could not get the
> ParsedPath or the PrevInstances statements to work properly. What
> exactly is 'ParsedPath anyway? When used it just adds 1 to the number
> of all the roomtags that were 'selected in the drawing. So in other
> words all of the roomtags end up being exactly the same. I 'think I
> am confused on the Array part. varblkAttribs(0).TextString
> = txtStrtNum.Text & ParsedPath & (PrevInstances + 1) Next
> Set GetEntity = Ent
> End With
> Ent.Highlight False
> Loop
> End If
> End Sub Thanx again for any help that anyone can provide. Rob

[Anonymous]

Hi again Rob,
Give this a shot.
-Josh 🙂

Private Sub cmdRun_Click()

Dim fType, fData, ss As AcadSelectionSet
Dim varblkAttribs As Variant
Dim strblkAttribs As String
Dim blkRef As AcadBlockReference
Dim objBlkSelect As AcadSelectionSet
Dim intarray() As Integer
Dim attarry As AcadAttribute
Dim Point(0 To 2) As Double
Dim strArray As String
Dim Acadblock As AcadBlockReference
Dim Ent As AcadEntity
Dim Pt As Variant

With ThisDrawing.Utility
Set ss = CreateSelectionSet()
BuildFilter fType, fData, 0, "INSERT", 2, "ROOMTAG"
ss.Select acSelectionSetAll, , , fType, fData
.Prompt vbCr & "There are " & ss.Count & " Roomtags in this drawing.
"
End With
Me.Hide
On Error Resume Next
If ss.Count > 0 Then
Do
ThisDrawing.Utility.GetEntity Ent, Pt, "Select the roomtags in
order :"
Ent.Highlight True
If Err Then
If ThisDrawing.GetVariable("errno") = "7" Then
Err.Clear
Else
Err.Clear
Exit Do
End If
End If
If TypeOf Ent Is AcadBlockReference Then
Set blkRef = Ent
If blkRef.Name = "roomtag" Then
If blkRef.HasAttributes Then
varblkAttribs = blkRef.GetAttributes
varblkAttribs(0).TextString = txtStrtNum.Text
'For i = LBound(varblkAttribs) To
UBound(varblkAttribs)
' Select Case varblkAttribs(i).TagString
' Case "yatta_this"
' varblkAttribs(i).TextString =
"Yatta_That"
' Case "AnyWho"
' varblkAttribs(i).TextString = "AnyHow"
' End Select
'Next i
End If
End If
Else
MsgBox "The Object You Selected Is Not A Roomtag."
End If
'Set GetEntity = Ent 'I don't know what this is for?
Ent.Highlight False
Loop
End If
End Sub

[Anonymous]

Oh yeah almost forgot. You said the textstrings were all coming out the
same. That's because they're all being set to the value of
"txtStrtNum.Text". Here's a quick update that just places a number in
the attribute as they are picked.

Private Sub cmdRun_Click()

Dim fType, fData, ss As AcadSelectionSet
Dim varblkAttribs As Variant
Dim strblkAttribs As String
Dim blkRef As AcadBlockReference
Dim objBlkSelect As AcadSelectionSet
Dim intarray() As Integer
Dim attarry As AcadAttribute
Dim Point(0 To 2) As Double
Dim strArray As String
Dim Acadblock As AcadBlockReference
Dim Ent As AcadEntity
Dim Pt As Variant
Dim Cnt As Integer

With ThisDrawing.Utility
Set ss = CreateSelectionSet()
BuildFilter fType, fData, 0, "INSERT", 2, "ROOMTAG"
ss.Select acSelectionSetAll, , , fType, fData
.Prompt vbCr & "There are " & ss.Count & " Roomtags in this drawing.
"
End With
Me.Hide
Cnt = 1
On Error Resume Next
If ss.Count > 0 Then
Do
ThisDrawing.Utility.GetEntity Ent, Pt, "Select the roomtags in
order :"
Ent.Highlight True
If Err Then
If ThisDrawing.GetVariable("errno") = "7" Then
Err.Clear
Else
Err.Clear
Exit Do
End If
End If
If TypeOf Ent Is AcadBlockReference Then
Set blkRef = Ent
If blkRef.Name = "roomtag" Then
If blkRef.HasAttributes Then
varblkAttribs = blkRef.GetAttributes
varblkAttribs(0).TextString = Cnt 'txtStrtNum.Text
'For i = LBound(varblkAttribs) To
UBound(varblkAttribs)
' Select Case varblkAttribs(i).TagString
' Case "yatta_this"
' varblkAttribs(i).TextString =
"Yatta_That"
' Case "AnyWho"
' varblkAttribs(i).TextString = "AnyHow"
' End Select
'Next i
End If
End If
Cnt = Cnt + 1
Else
MsgBox "The Object You Selected Is Not A Roomtag."
End If
'Set GetEntity = Ent 'I don't know what this is for?
Ent.Highlight False
Loop
End If
End Sub

[Anonymous]

"You are the Man Josh"!!!

It works great, I just need to do some fine tuning here and there. I
greatly appreciate the help. I can't thank you enough. How did you VB/VBA
wizes possibly learn all of this without the newsgroups.

Rob

"Minkwitz Design" wrote in message
news:3ABBBD2F.1AEBEE59@minkwitz-design.com...
> Oh yeah almost forgot. You said the textstrings were all coming out the
> same. That's because they're all being set to the value of
> "txtStrtNum.Text". Here's a quick update that just places a number in
> the attribute as they are picked.
>
> Private Sub cmdRun_Click()
>
> Dim fType, fData, ss As AcadSelectionSet
> Dim varblkAttribs As Variant
> Dim strblkAttribs As String
> Dim blkRef As AcadBlockReference
> Dim objBlkSelect As AcadSelectionSet
> Dim intarray() As Integer
> Dim attarry As AcadAttribute
> Dim Point(0 To 2) As Double
> Dim strArray As String
> Dim Acadblock As AcadBlockReference
> Dim Ent As AcadEntity
> Dim Pt As Variant
> Dim Cnt As Integer
>
> With ThisDrawing.Utility
> Set ss = CreateSelectionSet()
> BuildFilter fType, fData, 0, "INSERT", 2, "ROOMTAG"
> ss.Select acSelectionSetAll, , , fType, fData
> .Prompt vbCr & "There are " & ss.Count & " Roomtags in this drawing.
> "
> End With
> Me.Hide
> Cnt = 1
> On Error Resume Next
> If ss.Count > 0 Then
> Do
> ThisDrawing.Utility.GetEntity Ent, Pt, "Select the roomtags in
> order :"
> Ent.Highlight True
> If Err Then
> If ThisDrawing.GetVariable("errno") = "7" Then
> Err.Clear
> Else
> Err.Clear
> Exit Do
> End If
> End If
> If TypeOf Ent Is AcadBlockReference Then
> Set blkRef = Ent
> If blkRef.Name = "roomtag" Then
> If blkRef.HasAttributes Then
> varblkAttribs = blkRef.GetAttributes
> varblkAttribs(0).TextString = Cnt 'txtStrtNum.Text
> 'For i = LBound(varblkAttribs) To
> UBound(varblkAttribs)
> ' Select Case varblkAttribs(i).TagString
> ' Case "yatta_this"
> ' varblkAttribs(i).TextString =
> "Yatta_That"
> ' Case "AnyWho"
> ' varblkAttribs(i).TextString = "AnyHow"
> ' End Select
> 'Next i
> End If
> End If
> Cnt = Cnt + 1
> Else
> MsgBox "The Object You Selected Is Not A Roomtag."
> End If
> 'Set GetEntity = Ent 'I don't know what this is for?
> Ent.Highlight False
> Loop
> End If
> End Sub
>

[Anonymous]

Hi Rob,

"How did you VB/VBA
wizes possibly learn all of this without the newsgroups."

We didn't 🙂 Even if you are the VB stud of the year, chances are you won't
now your way around the acad model without either attending AU (that wasn't
available when I started), signing up for a newsletter (A Code A Day), getting
a book (Joe's VBA for acad ref), having a variety of working examples (my
predecessor / ok semi-working examples), frequenting the ng, or all of the
above.

Rob Outman wrote:

> "You are the Man Josh"!!!
>
> It works great, I just need to do some fine tuning here and there. I
> greatly appreciate the help. I can't thank you enough. How did you VB/VBA
> wizes possibly learn all of this without the newsgroups.