Introduction

This article is written for an audience of Visual Basic for Applications (VBA) programmers. Specifically, VBA programmers wanting to write code for Bentley Systems MicroStation® VBA.

Questions similar to this appear on the Bentley Discussion Groups.

Q How can I select line elements of a specified size?

A MicroStation stores element in models (VBA ModelReference). A model contains zero or more elements. We can scan a model for line elements and reject those that fail to pass our length limits.

Q How do I write line elements to a text file?

A We can open a text file for writing before we scan a model. Then, add data to the text file for each interesting element found by our scan.

In this example, we write the Element ID, start-point and end-point of each line found by our scan function.

VBA Solution

Line Filter form

A line is represented by a LineElement object. One of its properties is Length (in the model's master units). We need to examine each LineElement in a model and determine whether its length falls between an upper and lower limit. How do we examine each LineElement?

Model Scanner

The scan engine is one way to examine each element in a DGN model. It is implemented in VBA by the ModelReference.Scan method. You can specify filtering criteria through the ScanCriteria object. In this case, we want the scan engine to find LineElements for us, which we then compare to our limits …

Public Function ScanLinesByLength( _
    ByVal MinLength As Double, _
    ByVal MaxLength As Double, _
    ByVal AddToSelection As Boolean, _
    ByVal oFile As Scripting.TextStream) As Long

    ScanLinesByLength = 0
    Dim nLines                              As Long
    nLines = 0

    ActiveModelReference.UnselectAllElements

    Dim oCriteria                           As New ElementScanCriteria
    oCriteria.ExcludeNonGraphical
    oCriteria.ExcludeAllTypes
    oCriteria.IncludeType msdElementTypeLine

    Dim oLines                              As ElementEnumerator
    Set oLines = ActiveModelReference.Scan(oCriteria)
    While (oLines.MoveNext)
        Dim oLine                           As LineElement
        Set oLine = oLines.Current.AsLineElement
        If (oLine.Length > MinLength) And (oLine.Length < MaxLength) Then
            oLine.Color = 12
            oLine.Redraw msdDrawingModeNormal
            If AddToSelection Then
                ActiveModelReference.SelectElement oLine
            End If
            If (Not oFile Is Nothing) Then
                AddToFile oLine, oFile
            End If
            nLines = 1 + nLines
        End If
    Wend
    ScanLinesByLength = nLines
End Function

How do you tell the scanner what values to assume for MinLength and MaxLength? In this example, the user supplies the values through a VBA UserForm. The screenshot above shows the UserForm and the text boxes that display the user settings.

The Scan button starts things off. It calls the ScanLinesByLength function, passing the minimum and maximum length values from the form. An additional parameter tells the ScanLinesByLength whether to add each valid line to a MicroStation Selection Set, or just tell us how many lines it found.

The FilterLines VBA project is available free of charge. You can download it here. It includes the working VBA code, including the UserForm above. The project is not protected, so you can dissect it and modify it to suit your particular purpose.

Microsoft Scripting Runtime

We add a reference in our VBA project to Microsoft Scripting Runtime (scrrun.dll). Microsoft Scripting Runtime should be in every VBA programmer's toolbox: it provides a nice way to examine the Windows file system, open and read or write a file.

In this example we create a FileSystemObject and use that to open a TextStream file …

Private Sub cmdScan_Click()
    Dim nLines                              As Long
    Dim writeToFile                         As Boolean
    Dim oFile                               As Scripting.TextStream
    If chkWriteToFile.Value Then
        writeToFile = True
        Dim oFileSystem                     As Scripting.FileSystemObject
        Set oFileSystem = New Scripting.FileSystemObject
        Set oFile = oFileSystem.OpenTextFile(txtCsvFile.Text, ForWriting, True)
        ' Header for CSV file
        oFile.WriteLine "ElementID,X,Y,Z"
    Else
        writeToFile = False
    End If

    nLines = ScanLinesByLength(MinLength, MaxLength, AddToSelection, oFile)
    Me.lblLineCount.Caption = "Found " & CStr(nLines) & " lines"

    If writeToFile Then
        oFile.Close
    End If

End Sub

While scanning the model, we call function AddToFile to write the LineElement data in CSV format …

Sub AddToFile(ByVal oLine As LineElement, ByVal oFile As Scripting.TextStream)
    Dim point1                              As Point3d, _
        point2                              As Point3d
    Dim id                                  As DLong
    id = oLine.id
    point1 = oLine.EndPoint
    point2 = oLine.StartPoint
    Dim s                                   As String
    Const Comma                             As String = ","
    '   Element ID, X, Y, Z
    s = DLongToString(id) & Comma & _
        Format(point1.X, "0.0##") & Comma & _
        Format(point1.Y, "0.0##") & Comma & _
        Format(point1.Z, "0.0##")
    oFile.WriteLine s
End Sub

The CSV content is plain text. It looks something like this …

ElementID,X,Y,Z
594,1.0,0.0,0.0
595,1.0,1.0,0.0
596,2.0,1.0,0.0
597,2.0,2.0,0.0
599,3.0,2.0,0.0
601,3.0,3.0,0.0
602,4.0,3.0,0.0
603,4.0,4.0,0.0
604,5.0,4.0,0.0
605,5.0,5.0,0.0
606,6.0,5.0,0.0
655,1.461,3.728,0.0

Download

Download the Line Filter

You can download the Line Filter MVBA project. The project includes the MVBA project FilterLines.mvba and an example DGN file with a few lines used to test the project.