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.
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
?
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 LineElement
s 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.
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
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.
C:\Program Files\Bentley\Workspace\Standards\vba
vba run [FilterLines]modMain.Main