I've been creating a tool in vba to quantify the bid items for construction drawings. Basically, it counts things and does some math. I can get the tool to work in the basic case, which is to scan all elements in the file, but I am trying to create an option to scan only selected items. I could not figure out how to scan only within a selection set. I eventually opted to create a named group with the selected items hoping to utilize the msdElementTypeNamedGroupComponent in scan criteria, but that does not work. Any guidance into using msdElementTypeNamedGroupComponent or scanning within a selection set would be helpful. I've included a simplified version of my code (as is) below:
Sub main()
Dim nCells As Integer
Dim nArrows As Integer
Dim nBikes As Integer
Dim nOnlys As Integer
Dim nSchoolSMs As Integer
Dim nSchoolLGs As Integer
Dim nXings As Integer
Dim nCrossings As Integer
Dim nRRs As Integer
Dim nNRRs As Integer
Dim nBRRs As Integer
Dim nHOVs As Integer
Dim nBus As Integer
Dim nCattles As Integer
Dim nHCs As Integer
Dim npark As Integer
Dim nylds As Integer
Dim nXwalk As Integer
Dim groupname As String
Dim mygroup As NamedGroupElement
Dim ee As ElementEnumerator
Dim n As Integer
n = 0
Const levName As String = "P_TRAF_ROAD_LEGENDS"
Select Case True
Case ActiveModelReference.AnyElementsSelected
Debug.Print "TRUE"
groupname = "Selected"
Set mygroup = ActiveModelReference.GetNamedGroup("Selected")
If (mygroup Is Nothing) Then
Set mygroup = ActiveModelReference.AddNewNamedGroup(groupname)
Debug.Print "set new group"
Else
ActiveModelReference.RemoveElement mygroup
Set mygroup = ActiveModelReference.AddNewNamedGroup(groupname)
Debug.Print "Didn't work"
End If
Set ee = ActiveModelReference.GetSelectedElements
Do While ee.MoveNext
n = n + 1
mygroup.AddMember ee.Current
Loop
Debug.Print n
Case Else
groupname = "none"
End Select
mygroup.Rewrite
nCells = CountCells(levName, nArrows, nBikes, nOnlys, nSchoolSMs, nSchoolLGs, nXings, nCrossings, nRRs, nNRRs, nBRRs, nHOVs, nBus, nCattles, nHCs, npark, nylds, nXwalk)
Debug.Print nCells
'Debug.Print "Arrow: " & arrowcount & "; Bike Stencil: " & bikecount & "; Onlys: " & nOnlys & "; SM Sch: " & schoolSMcount & "; LG Sch: " & schoolLGcount & "; X-ing: " & nXings & "; Crossing: " & nCrossings & "; RR: " & nRRs & "; Narrow RR: " & nNRRs & "; Bike RR: " & nBRRs & "; HOV: " & nHOVs & "; BUS: " & nBus & "; Cattle: " & nCattles & "; Handicap: " & nHCs & "; Parking: " & npark & "; Yields: " & nylds & "; Sq Ft CW: "; nXwalk'MsgBox "Found " & nElements & " elements, measuring " & Format(outcome, "###,##0.00") & " feet of elements with that linestyle.", vbInformation Or vbOKOnly, "Scanned Elements"
End Sub' --------------------------------------------------------------' Get Counts of Cells' --------------------------------------------------------------
Function CountCells(ByVal levName As String, _
ByRef nArrows As Integer, ByRef nBikes As Integer, ByRef nOnlys As Integer, ByRef nSchoolSMs As Integer, ByRef nSchoolLGs As Integer, ByRef nXings As Integer, ByRef nCrossings As Integer, ByRef nRRs As Integer, ByRef nNRRs As Integer, ByRef nBRRs As Integer, ByRef nHOVs As Integer, ByRef nBus As Integer, ByRef nCattles As Integer, ByRef nHCs As Integer, ByRef npark As Integer, ByRef nylds As Integer, ByRef nXwalk As Integer) As Integer
Dim pos As Integer
Dim olevel As Level
Set olevel = ActiveModelReference.Levels("P_TRAF_ROAD_Legends")
Dim olevel2 As Level
Set olevel2 = ActiveModelReference.Levels("P_TRAF_ROAD_Striping")
Dim nCells As Integer
nBikes = 0
nArrows = 0
nOnlys = 0
nSchoolSMs = 0
nSchoolLGs = 0
nXings = 0
nRRs = 0
nNRRs = 0
nBRRs = 0
nHOVs = 0
nBus = 0
nCattles = 0
nHCs = 0
npark = 0
nylds = 0
nXwalk = 0' Set up scan criteria
Dim oScanCriteria As New ElementScanCriteria
oScanCriteria.ExcludeAllLevels
oScanCriteria.IncludeLevel olevel
oScanCriteria.IncludeLevel olevel2
oScanCriteria.ExcludeAllTypes'oScanCriteria.IncludeType msdElementTypeCellHeader
oScanCriteria.IncludeType msdElementTypeNamedGroupComponent
oScanCriteria.IncludeType msdElementTypeNamedGroupHeader' Perform the scan
Dim oEnumerator As ElementEnumerator
Set oEnumerator = ActiveModelReference.Scan(oScanCriteria)
Do While oEnumerator.MoveNext
nCells = nCells + 1
pos = InStr(oEnumerator.Current.AsCellElement.Name, "BIKE")
If pos > 0 Then
nBikes = nBikes + 1
End If
pos = InStr(oEnumerator.Current.AsCellElement.Name, "SHARED")
If pos > 0 Then
nBikes = nBikes + 1
End If
pos = InStr(oEnumerator.Current.AsCellElement.Name, "ARROW")
If pos > 0 Then
nArrows = nArrows + 1
End If
pos = InStr(oEnumerator.Current.AsCellElement.Name, "ON")
If pos > 0 Then
nOnlys = nOnlys + 1
End If
pos = InStr(oEnumerator.Current.AsCellElement.Name, "SCH")
If pos > 0 Then
pos = InStr(oEnumerator.Current.AsCellElement.Name, "SCH-LG")
If pos > 0 Then
nSchoolLGs = nSchoolLGs + 1
Else
nSchoolSMs = nSchoolSMs + 1
End If
End If
pos = InStr(oEnumerator.Current.AsCellElement.Name, "CROSSING")
If pos > 0 Then
nCrossings = nCrossings + 1
End If
pos = InStr(oEnumerator.Current.AsCellElement.Name, "XING")
If pos > 0 Then
nXings = nXings + 1
End If
pos = InStr(oEnumerator.Current.AsCellElement.Name, "RAILROAD_RR")
If pos > 0 Then
nRRs = nRRs + 1
End If
pos = InStr(oEnumerator.Current.AsCellElement.Name, "RAILROAD_NRR")
If pos > 0 Then
nNRRs = nNRRs + 1
End If
pos = InStr(oEnumerator.Current.AsCellElement.Name, "RAILROAD_BRR")
If pos > 0 Then
nBRRs = nBRRs + 1
End If
pos = InStr(oEnumerator.Current.AsCellElement.Name, "HOV")
If pos > 0 Then
nHOVs = nHOVs + 1
End If
pos = InStr(oEnumerator.Current.AsCellElement.Name, "CATTLE")
If pos > 0 Then
nCattles = nCattles + 1
End If
pos = InStr(oEnumerator.Current.AsCellElement.Name, "HC")
If pos > 0 Then
nHCs = nHCs + 1
End If
pos = InStr(oEnumerator.Current.AsCellElement.Name, "PLUS")
If pos > 0 Then
npark = npark + 1
End If
pos = InStr(oEnumerator.Current.AsCellElement.Name, "TEE")
If pos > 0 Then
npark = npark + 1
End If
pos = InStr(oEnumerator.Current.AsCellElement.Name, "YLD")
If pos > 0 Then
nylds = nylds + 1
End If
pos = InStr(oEnumerator.Current.AsCellElement.Name, "BUS")
If pos > 0 Then
nBus = nBus + 1
End If
pos = InStr(oEnumerator.Current.AsCellElement.Name, "CW_SC")
If pos > 0 Then
nXwalk = nXwalk + 18
End If'Debug.Print oEnumerator.Current.AsCellElement.Name & " " & pos
Loop
CountCells = nCells
End Function