VBA and attributed blocks II

[Anonymous]

Hi again! (continuation of my ealier post 'VBA and attributed blocks' - - - I need to start with a clean sheet!!!)

I have an unknown number of RoomData blocks within a drawing.

Each one is uniquely identified by a ROOMNUM attribute (e.g. 001 thru 999).
But, the blocks may not necessarily be identified consequitively. e.g total count of 8 blocks,
numbered 001, 002, 003, 004, 007, 008, 009, 010. (numbers 005, 006 missing).
Each block is also grouped within different buildings and this is identified by a
BLOCKNAME attribute (e.g. 01 thru 99).
Eack block also has an AREA attribute (e.g. 45.0)

The aim of the game is to be able to:

i) count the total number of RoomData blocks **DONE**

ii) find the highest value of the ROOMNUM attribute

iii) find, if any, the missing ROOMNUM attributes in the sequence
(as in the above example this would be 005 & 006)

iv) sum all the AREA attributes. **DONE**

v) count the number of RoomData blocks per BLOCKNAME attribute.
(e.g. 001, 002, 003, 004 have BLOCKNAME value of 01 and
007, 008, 009, 010 have BLOCKNAME value of 02)

vi) sum the AREA attributes per BLOCKNAME attribute.
(e.g sum of AREA values for 001, 002, 003, 004 and
sum of AREA values for 007, 008, 009, 010)

The most important bit I need to sort out is summing the Area attributes per BLOCKNAME (vi).

Thanks very much to all those who replied to my previous thread and look forward to hearing from you!

Many thanks,
Dom

[Anonymous]

dom,

Can you zip and post the drawing with these blocks.
If I look at your blocks I can better understand, I think I have done something similar that I can modify to fit your requirements

Maximo

[Anonymous]

HI Maximo,

Thanks for the reply,

I've attached an example of a drawing as requested.

Many thanks

Dom

[Anonymous]

Reposting
Go to view and click on immediate and local windows
click in the sub isconseq and hit F8 a few times to cycle through the code
[code]
Sub isconseq()

Dim C As Collection
Dim Sel As AcadSelectionSet
Dim i As Integer
Set Sel = sset(Array(0, 2), Array("Insert", "RoomData"))
Set C = Sort(Sel)
For i = 1 To C.count
Debug.Print C(i)
Next

End Sub


Function Sort(objSS As AcadSelectionSet) As Collection
Dim Atts
Dim intCol() As Integer
Dim MissingCol As New Collection
Dim I1 As Integer, I2 As Integer
Dim i As Integer, j As Integer
Dim NumStrings As Integer, iTemp As Integer
Dim b As AcadBlockReference

NumStrings = objSS.count
ReDim intCol(NumStrings - 1)

For i = 0 To NumStrings - 1
Set b = objSS(i)
intCol(i) = CInt(b.GetAttributes(2).TextString)
Next

For i = 0 To NumStrings - 1
For j = i + 1 To NumStrings - 1
If intCol(i) > intCol(j) Then
I1 = intCol(i): I2 = intCol(j)
iTemp = I1
I1 = I2
I2 = iTemp
intCol(i) = I1: intCol(j) = I2
End If
Next
Next

For i = 0 To NumStrings - 2
If intCol(i + 1) - intCol(i) > 1 Then
For j = intCol(i) + 1 To intCol(i + 1) - 1
MissingCol.Add j
Next j
End If
Next i

Set Sort = MissingCol
End Function


Public Function sset(FilterType, FilterData As Variant, Optional ssName As String = "SS") As AcadSelectionSet

Dim oSSets As AcadSelectionSets
Set oSSets = ThisDrawing.SelectionSets
For Each sset In oSSets
If sset.Name = ssName Then
sset.Delete
Exit For
End If
Next
Dim FType() As Integer
Dim FData() As Variant
Dim i As Integer
If IsArray(FilterType) = False Then
If IsArray(FilterData) = False Then
ReDim FType(0)
ReDim FData(0)
FType(0) = FilterType
FData(0) = FilterData
Else
Exit Function
End If
Else
If UBound(FilterType) <> UBound(FilterData) Then
Exit Function 'They must be pairs
End If
'If UBound(FilterType) = 1 Then

ReDim FType(UBound(FilterType))
ReDim FData(UBound(FilterType))
For i = 0 To UBound(FilterType)
FType(i) = FilterType(i)
FData(i) = FilterData(i)
Next
End If

Set sset = ThisDrawing.SelectionSets.Add(ssName)
sset.Select 5, FilterType:=FType, FilterData:=FData
'To use this function for single filter
'Set SS = SSet(0, "insert")
'For multiple filter
'Set SS = SSet(array(0,2),array("insert",oBlock.name)) 'must be pairs
End Function

[/code]

[Anonymous]

Hi,

In your sset function, should the following:
*************
If UBound(FilterType) UBound(FilterData) Then
Exit Function 'They must be pairs
End If
*************
Read:
*************
If UBound(FilterType) = UBound(FilterData) Then
Exit Function 'They must be pairs
End If
*************

If so, I'm getting a runtime error, flagging up the line (in sort function)
*************
NumStrings = objSS.Count
*************

Is it because the selection set is empty?

Thanks for bearing with me!

Dom

[Anonymous]

(<>) I forgot you can't post brackets

[Anonymous]

Hi,

I'm sorry but I don't follow.....

[Anonymous]

If not UBound(FilterType)= UBound(FilterData) Then
use this since this site wont print
If UBound(FilterType) (<>) UBound(FilterData) Then correctly

[Anonymous]

Thanks Bryco,

I've got it working..thanks very much for your help

Dom

[Anonymous]

Hi,

Does anyone know if part (iv) of my problem is solvable?!

vi) sum the AREA attributes per BLOCKNAME attribute.
(e.g sum of AREA values for 001, 002, 003, 004 and
sum of AREA values for 007, 008, 009, 010)

Thanks!

Dom

[Anonymous]

My mistake, meant to read Part (vi)