Scanning a Model using VBA

Questions similar to this appear on the Be Community Forums. This problem appeared in the VBA Forum.

Q How do I find elements on a specific level using VBA?

Q How do I find elements of a particular type (e.g. text elements) using VBA?

A MicroStation includes a scanning engine that is used for many purposes. It's available to you in VBA as the ModelReference.Scan method. You specify what you want to search for (e.g. levels) through the ElementScanCriteria object.

The methodology of scanning a model is straightforward …

• Decide what you want to find

This could be, for example, elements on a certain level, elements of a certain type, or some combination of those criteria

• Create an ElementScanCriteria object and specify your filter requirements
• Invoke the ModelReference.Scan method
• Enumerate the elements that pass the scan criteria

Enumeration provides you with a list of elements, each of which has already passed the test you imposed with your scan criteria. So, if you specified a level filter, you know that each element received from the enumerator belongs to one of the levels specified. If your scan criteria requested only text elements, then each element returned by the enumerator will be a TextElement.

Main entry point 
Sub Main()
    Dim nElements   As Long
    Const levelName As String = "Level 11"
    nElements = ScanByLevel(levelName)
    MsgBox "Found " & CStr(nElements) & " elements on level '" & levelName & "'", vbInformation Or vbOKOnly, "Scanned Elements"
End Sub
' -------------------------------------------------------------- 
' Process any element that meets the scan criteria: named level 
' -------------------------------------------------------------- 
Function ScanByLevel(levelName As String) As Long
    Dim oScanCriteria   As ElementScanCriteria
    Dim oEnumerator     As ElementEnumerator
    Set oScanCriteria = New ElementScanCriteria
    Dim nElements       As Long

    Dim oLevel          As Level
    Set oLevel = ActiveModelReference.Levels(levelName)
    If (oLevel Is Nothing) Then
        MsgBox "Level '" & levelName & "' does not exist", vbCritical Or vbOKOnly, "Nonexistent Level"
        Exit Function
    End If
    oScanCriteria.ExcludeAllLevels
    oScanCriteria.IncludeLevel oLevel

    Set oEnumerator = ActiveModelReference.Scan(oScanCriteria)
    While oEnumerator.MoveNext = True
        oEnumerator.Current.Redraw msdDrawingModeHilite
        nElements = nElements + 1
    Wend
    ScanByLevel = nElements
End Function

Main entry point 
Sub Main()
    Dim nElements   As Long
    nElements = ScanForText(levelName)
    MsgBox "Found " & CStr(nElements) & " text elements", vbInformation Or vbOKOnly, "Text Elements"
End Sub
' -------------------------------------------------------------- 
' Process text elements                                          
' -------------------------------------------------------------- 
Function ScanTextElements() As Long
    Dim nElements       As Long
    Dim oScanCriteria   As ElementScanCriteria
    Dim oEnumerator     As ElementEnumerator
    Set oScanCriteria = New ElementScanCriteria

    Const MatchHeight As Double = 0.0035
    Const MatchWidth As Double = 0.0025
    Const Epsilon As Double = 0.00001

    nElements = 0

    oScanCriteria.ExcludeAllTypes
    oScanCriteria.IncludeType msdElementTypeText

    Set oEnumerator = ActiveModelReference.Scan(oScanCriteria)
    While oEnumerator.MoveNext = True
        oEnumerator.Current.Redraw msdDrawingModeHilite
        With oEnumerator.Current.AsTextElement
            Dim width   As Double, _
                height  As Double

            width = .TextStyle.width
            height = .TextStyle.height
            Debug.Print "Found text '" & .Text & "' width=" & FormatNumber(width, 6, True) & " height=" & FormatNumber(height, 6, True)

            If (Epsilon > Abs(MatchWidth - width)) Then
                Debug.Print "Matched width " & FormatNumber(width, 6, True)
            End If

            If (Epsilon > Abs(MatchHeight - height)) Then
                Debug.Print "Matched height " & FormatNumber(height, 6, True)
            End If

            If ((Epsilon > Abs(MatchWidth - width)) _
                And _
                (Epsilon > Abs(MatchHeight - height))) Then
                Debug.Print "Matched text '" & .Text & "'"
                MsgBox "Matched Text Element!"
                nElements = 1 + nElements
            End If
        End With
        oEnumerator.Current.Redraw msdDrawingModeNormal
    Wend
    ScanTextElements = nElements
End Function