Extracting attribute information from existing blocks

[Anonymous]

Can anyone help !
I currently have some code which works fine until other entitys are added
into the drawing.
When executing, a 'Type Mismatch' error is displayed.
Would I be correct in thinking it is something to do with Blocks statement ?

Thanks in advance
Dave

The code is as follows:

Dim SelSetObj As AcadSelectionSet
Dim Num As Integer

'interogate drawing for scale and revsion status
'set up selection set
Set SelSetObj = ThisDrawing.SelectionSets.Add("TEST_SSET")
SelSetObj.Select acSelectionSetAll

Num = SelSetObj.Count

'read block attributes and set to user input
** For Each Blocks In SelSetObj **
If Blocks.EntityName = "AcDbBlockReference" Then
If Blocks.HasAttributes = True Then
Attributes = Blocks.GetAttributes
For I = LBound(Attributes) To UBound(Attributes)
If Attributes(I).TagString = "REV" Then
NewRev = Attributes(I).TextString + 1
Attributes(I).TextString = NewRev
End If
If Attributes(I).TagString = "SCALE" Then
FrameScale = Attributes(I).TextString
End If
Next
End If
End If
Next

[Anonymous]

blocks should be defined as AcadEntity
Dave Wilkinson wrote in message
news:7ED5632B95005D5A6ABE3D1C9B808C72@in.WebX.SaUCah8kaAW...
> Can anyone help !
> I currently have some code which works fine until other entitys are added
> into the drawing.
> When executing, a 'Type Mismatch' error is displayed.
> Would I be correct in thinking it is something to do with Blocks statement
?
>
> Thanks in advance
> Dave
>
> The code is as follows:
>
> Dim SelSetObj As AcadSelectionSet
> Dim Num As Integer
>
> 'interogate drawing for scale and revsion status
> 'set up selection set
> Set SelSetObj = ThisDrawing.SelectionSets.Add("TEST_SSET")
> SelSetObj.Select acSelectionSetAll
>
> Num = SelSetObj.Count
>
> 'read block attributes and set to user input
> ** For Each Blocks In SelSetObj **
> If Blocks.EntityName = "AcDbBlockReference" Then
> If Blocks.HasAttributes = True Then
> Attributes = Blocks.GetAttributes
> For I = LBound(Attributes) To UBound(Attributes)
> If Attributes(I).TagString = "REV" Then
> NewRev = Attributes(I).TextString + 1
> Attributes(I).TextString = NewRev
> End If
> If Attributes(I).TagString = "SCALE" Then
> FrameScale = Attributes(I).TextString
> End If
> Next
> End If
> End If
> Next
>

[Anonymous]

Hi Dave

This should do it.

--------------------------------------------------------
Option Explicit

Sub test()

Dim SelSetObj As AcadSelectionSet
Dim Num As Integer
Dim Attributes As Variant
Dim Blocks As AcadBlockReference
Dim DXFData(0) As Variant
Dim I As Integer
Dim NewRev, FrameScale As String
'interogate drawing for scale and revsion status
'set up selection set
Set SelSetObj = ThisDrawing.SelectionSets.Add("TEST_SSET")

DXFCode(0) = 0: DXFData(0) = "INSERT"

SelSetObj.Select acSelectionSetAll, , , DXFCode, DXFData

Num = SelSetObj.Count

'read block attributes and set to user input
For Each Blocks In SelSetObj
If Blocks.HasAttributes = True Then
Attributes = Blocks.GetAttributes
For I = LBound(Attributes) To UBound(Attributes)
If Attributes(I).TagString = "REV" Then
NewRev = Attributes(I).TextString + 1
Attributes(I).TextString = NewRev
End If
If Attributes(I).TagString = "SCALE" Then
FrameScale = Attributes(I).TextString
End If
Next
End If
Next

SelSetObj.Delete
End Sub
-------------------------------------------------------------------

Trond Hasse Lie
Norway

"Dave Wilkinson" wrote in message
news:7ED5632B95005D5A6ABE3D1C9B808C72@in.WebX.SaUCah8kaAW...
> Can anyone help !
> I currently have some code which works fine until other entitys are added
> into the drawing.
> When executing, a 'Type Mismatch' error is displayed.
> Would I be correct in thinking it is something to do with Blocks statement
?
>
> Thanks in advance
> Dave
>
> The code is as follows:
>
> Dim SelSetObj As AcadSelectionSet
> Dim Num As Integer
>
> 'interogate drawing for scale and revsion status
> 'set up selection set
> Set SelSetObj = ThisDrawing.SelectionSets.Add("TEST_SSET")
> SelSetObj.Select acSelectionSetAll
>
> Num = SelSetObj.Count
>
> 'read block attributes and set to user input
> ** For Each Blocks In SelSetObj **
> If Blocks.EntityName = "AcDbBlockReference" Then
> If Blocks.HasAttributes = True Then
> Attributes = Blocks.GetAttributes
> For I = LBound(Attributes) To UBound(Attributes)
> If Attributes(I).TagString = "REV" Then
> NewRev = Attributes(I).TextString + 1
> Attributes(I).TextString = NewRev
> End If
> If Attributes(I).TagString = "SCALE" Then
> FrameScale = Attributes(I).TextString
> End If
> Next
> End If
> End If
> Next
>

[Anonymous]

Dave,

I imagine that you are only changing one or more blocks with the same name.
You can try this code for a more cleaner overview and run.

< snip >
Dim SelSetObj As AcadSelectionSet
Dim Attributes As Variant
Dim fType(0 To 1) As Integer, fData(0 To 1) As Variant
Dim NewRev, FrameScale As String

On Error Resume Next
Set SelSetObj = ThisDrawing.SelectionSets("temp")
If Err Then Set SelSetObj = ThisDrawing.SelectionSets.Add("temp")
SelSetObj.Clear
On Error GoTo 0

fType(0) = 0: fData(0) = "INSERT"
fType(1) = 2: fData(1) = "yourblockname"
SelSetObj.Select acSelectionSetAll, , , fType, fData

If SelSetObj.Count > 0 Then
For i = 0 To SelSetObj.Count - 1
Attributes = SelSetObj.Item(i).GetAttributes
For j = LBound(Attributes) To UBound(Attributes)
Select Case UCase(Attributes(j).TagString)

Case "REV"
NewRev = Attributes(j).TextString + 1
Attributes(j).TextString = NewRev

Case "SCALE"
FrameScale = Attributes(j).TextString

Case Else
End Select
Next
Next
End If

< snip >

If you have more tags in your block, just ad more "Case".

Rene

(and Frank for learning me this trick)

[Anonymous]

I have tried to define the Blocks as an AcadEntity, to no avail !
I receive the same error message as before, only this time it happens every
time, regardless of what entity's are present.

I have also tried the code below, which works fine. The problem here is that
I not using a single block name, and have the possibility of six different
names for the block.

Can anyone give me any further ideas.

Thanks for your time
Dave

Rene van Kwawegen wrote in message
<235B0BDC410656B11857D9534D5E0CCE@in.WebX.SaUCah8kaAW>...
>Dave,
>
>I imagine that you are only changing one or more blocks with the same name.
>You can try this code for a more cleaner overview and run.
>
>< snip >
>Dim SelSetObj As AcadSelectionSet
>Dim Attributes As Variant
>Dim fType(0 To 1) As Integer, fData(0 To 1) As Variant
>Dim NewRev, FrameScale As String
>
>On Error Resume Next
>Set SelSetObj = ThisDrawing.SelectionSets("temp")
>If Err Then Set SelSetObj = ThisDrawing.SelectionSets.Add("temp")
>SelSetObj.Clear
>On Error GoTo 0
>
>fType(0) = 0: fData(0) = "INSERT"
>fType(1) = 2: fData(1) = "yourblockname"
>SelSetObj.Select acSelectionSetAll, , , fType, fData
>
>If SelSetObj.Count > 0 Then
> For i = 0 To SelSetObj.Count - 1
> Attributes = SelSetObj.Item(i).GetAttributes
> For j = LBound(Attributes) To UBound(Attributes)
> Select Case UCase(Attributes(j).TagString)
>
> Case "REV"
> NewRev = Attributes(j).TextString + 1
> Attributes(j).TextString = NewRev
>
> Case "SCALE"
> FrameScale = Attributes(j).TextString
>
> Case Else
> End Select
> Next
> Next
>End If
>
>< snip >
>
>If you have more tags in your block, just ad more "Case".
>
>Rene
>
>(and Frank for learning me this trick)
>

[Anonymous]

If you use a selection set filter as both Trond and Rene suggested, your
selection set will contain nothing *but* block references, so there will be
no problem declaring your iterator object as AcadEntity or better yet:
AcadBlockReference. You may want to double-check the code you are using to
create your selection set.

--
Attitudes are contagious. Is yours worth catching?
http://www.acadx.com

"Dave Wilkinson" wrote in message
news:8EDD02D65C37A145D59441153C83A735@in.WebX.SaUCah8kaAW...
> I have tried to define the Blocks as an AcadEntity, to no avail !
> I receive the same error message as before, only this time it happens
every
> time, regardless of what entity's are present.
>
> I have also tried the code below, which works fine. The problem here is
that
> I not using a single block name, and have the possibility of six different
> names for the block.
>
> Can anyone give me any further ideas.

[Anonymous]

Yes Frank, you are quite right.
I had started to look at filters to give me a selection set of just blocks.
Now I have added in a filter, things seem to be working fine.

Thanks to everyone for your time
Dave

Frank Oquendo wrote in message ...
>If you use a selection set filter as both Trond and Rene suggested, your
>selection set will contain nothing *but* block references, so there will be
>no problem declaring your iterator object as AcadEntity or better yet:
>AcadBlockReference. You may want to double-check the code you are using to
>create your selection set.
>
>--
>Attitudes are contagious. Is yours worth catching?
>http://www.acadx.com
>
>"Dave Wilkinson" wrote in message
>news:8EDD02D65C37A145D59441153C83A735@in.WebX.SaUCah8kaAW...
>> I have tried to define the Blocks as an AcadEntity, to no avail !
>> I receive the same error message as before, only this time it happens
>every
>> time, regardless of what entity's are present.
>>
>> I have also tried the code below, which works fine. The problem here is
>that
>> I not using a single block name, and have the possibility of six
different
>> names for the block.
>>
>> Can anyone give me any further ideas.
>