Topic: Scripting Dictionary Help

[Guest]

I'm trying to create a list based on block attribute information.  I have a block right now with 4 attributes.  I would like to be able to create a list (or lists, depending on the block attribute tags).  Below is what I've got so far for code.  I've also attached an image to help demonstrate what I'd like to eventually do.  The 8 blocks on the left have the same name: TEMP. The attribute tags are ID, NUMBER, LOCATION, and COLOR.  The 2 lists on the
left are ultimately what I'm looking to create, but in Excel.

What I need help with right now is obtaining the information and have it sorted.

Any help will be greatly appreciated!

Code: [Select]

Option Explicit

Public objKeys As Variant
Public objItems As Variant
Public objDict As Dictionary

Public Sub DPW()
    Dim ent1 As AcadEntity
    Dim ent2 As AcadEntity
    Dim entXref As AcadExternalReference
    Dim entBlock As AcadBlock
    Dim entNestedBlock As AcadBlockReference
    Dim varAtts() As AcadAttributeReference
    Dim objBlock As AcadBlockReference
    Dim ssSet As AcadSelectionSet
    Dim FilterType(1) As Integer
    Dim FilterData(1) As Variant
    Dim obj As AcadEntity
    Dim i, x As Integer
   
    Set objDict = New Dictionary
    Set ssSet = vbdPowerSet("TEMP")
       
    FilterType(0) = 0
    FilterData(0) = "Insert"
    FilterType(1) = 2
    FilterData(1) = "*TEMP*"
   
    ssSet.Select acSelectionSetAll, , , FilterType, FilterData
    x = 1
    If ssSet.Count = 0 Then
        MsgBox "No blocks were found in this drawing!", vbInformation + vbOKOnly, "Quick Report"
        Exit Sub
    Else
        For Each obj In ssSet
            Set objBlock = obj
            If obj.HasAttributes Then
                varAtts = obj.GetAttributes
                For i = LBound(varAtts) To UBound(varAtts)
               
                    If UCase$(varAtts(i).TagString) = "ID" Then
                        If objDict.Exists(varAtts(i).TextString) = False Then
                            objDict.Add varAtts(i).TextString, 1
                        Else
                            objDict.Item(varAtts(i).TextString) = objDict.Item(varAtts(i).TextString) + 1
                        End If
                    End If
                   
                    If UCase$(varAtts(i).TagString) = "NUMBER" Then
                        If objDict.Exists(varAtts(i).TextString) = False Then
                            objDict.Add varAtts(i).TextString, 1
                        Else
                            objDict.Item(varAtts(i).TextString) = objDict.Item(varAtts(i).TextString) + 1
                        End If
                    End If
                   
                    If UCase$(varAtts(i).TagString) = "LOCATION" Then
                        If objDict.Exists(varAtts(i).TextString) = False Then
                            objDict.Add varAtts(i).TextString, 1
                        Else
                            objDict.Item(varAtts(i).TextString) = objDict.Item(varAtts(i).TextString) + 1
                        End If
                    End If
                   
                   
                    If UCase$(varAtts(i).TagString) = "COLOR" Then
                        If objDict.Exists(varAtts(i).TextString) = False Then
                            objDict.Add varAtts(i).TextString, 1
                        Else
                            objDict.Item(varAtts(i).TextString) = objDict.Item(varAtts(i).TextString) + 1
                        End If
                    End If
                    On Error GoTo 0
                Next i
            End If
        Next obj

        i = 0
       
        objKeys = objDict.Keys
        BubbleSort objKeys
        objItems = objDict.Items
       
        Dim filenum As Integer
        Dim strLine1 As String
       
        For x = 0 To UBound(objKeys)
            Debug.Print objKeys(x) & vbTab & vbTab & objDict(objKeys(x))
            i = i + objItems(x)
        Next
    End If
End Sub


Public Function vbdPowerSet(strName As String) As AcadSelectionSet
    Dim objSelSet As AcadSelectionSet
    Dim objSelCol As AcadSelectionSets
   
    Set objSelCol = ThisDrawing.SelectionSets
    For Each objSelSet In objSelCol
        If objSelSet.Name = strName Then
            objSelSet.Delete
            Exit For
        End If
    Next
    Set objSelSet = ThisDrawing.SelectionSets.Add(strName)
    Set vbdPowerSet = objSelSet
End Function

Sub BubbleSort(arr As Variant, Optional descending As Boolean, Optional numEls As Variant)
' Bubble Sort an array of any type
' Author: The VB2TheMax Team
' BubbleSort is especially convenient with small arrays (1,000
' items or fewer) or with arrays that are already almost sorted
'
' NUMELS is the index of the last item to be sorted, and is
' useful if the array is only partially filled.
'
' Works with any kind of array, except UDTs and fixed-length
' strings, and including objects if your are sorting on their
' default property. String are sorted in case-sensitive mode.
'
' You can write faster procedures if you modify the first two lines
' to account for a specific data type, eg.
' Sub BubbleSortS(arr() As Single, Optional descending As Boolean, Optional numEls As Variant)
'   Dim value As Single

    Dim Value As Variant
    Dim Index As Long
    Dim firstItem As Long
    Dim indexLimit As Long, lastSwap As Long

    ' account for optional arguments
    If IsMissing(numEls) Then numEls = UBound(arr)
    firstItem = LBound(arr)
    lastSwap = numEls

    Do
        indexLimit = lastSwap - 1
        lastSwap = 0
        For Index = firstItem To indexLimit
            Value = arr(Index)
            If (Value > arr(Index + 1)) Xor descending Then
                ' if the items are not in order, swap them
                arr(Index) = arr(Index + 1)
                arr(Index + 1) = Value
                lastSwap = Index
            End If
        Next
    Loop While lastSwap
End Sub




Matt W
"Being a Red Sox fan is like being a 120-pound man in a maximum security prison."

[Guest]

Okay... It looks like maybe I didn't post the image correctly or something.  Sometimes I see, sometimes I don't.

Here's what the image looks like:

==========================================
TEST01        TEST01        TEST01        TEST01
01                02               03                01, LEFT, BLUE
LEFT             LEFT            RIGHT         02, LEFT, GREEN
BLUE            GREEN          BLUE            03, RIGHT, BLUE
==========================================
TEST02        TEST02        TEST02        TEST02
01                03               04                01, RIGHT, YELLOW
RIGHT           CENTER       RIGHT          03, CENTER, CYAN
YELLOW        CYAN          YELLOW        04, RIGHT, YELLOW
==========================================

The columns on the right are what I'm looking to create from the attribute information (three columns) on the left.

I'm not sure if I can do this with ONE dictionary or if I would need two or more?!?!  If someone could point me in the right direction I would really appreciate it.

Thanks again!


Matt W

[Jim Yadon]

I'd like to help you out but I'm a Yankees fan. 



Seriously though, if you can wait until this evening I'll take a closer look at it and see how what I have compares and post it if it applies. During the interim, I'm sure one of our many resident genius's can help you out better than I can.

[Bob Wahr]

Much like the ALCS, it looks like a long night for Yankees fans.