Quantcast
Channel: MicroStation Programming Forum - Recent Threads
Viewing all articles
Browse latest Browse all 7260

[uStation v8i VBA] oEle.AsTextElement.Text in Find/Replace Text Project = "Pattern Control Element"

$
0
0

Hello once again.  I am trying to make a VBA Project to automate a process at my office within Microstation.  Please see the below image:

Upon the click event the button in the bottom right will scan through the Listview Row by Row and scans the active design file for a text element matching the respective value for "Movement ID".  I have done a good bit of debugging and I am running into a bizarre error.  I am getting a type mismatch error on the ElementEnumerator.Current.AsTextElement.Text.  The value is being returned as "Pattern Control Element".

Does anyone have any idea what would cause this error? 

Modeless Dialog Class

Public filePath As String
Private Sub bBrowse_Click()' Select File Dialog
On Error GoTo addLibrary_Error
    Dim strFilter As String' Filter files by File Extension *.csv
    strFilter = ahtAddFilterItem(strFilter, "Exported Traffic Data (*.csv)", "*.csv")' Prompt for File
    filePath = ahtCommonFileOpenSave(Filter:=strFilter, OpenFile:=False, _
                    DialogTitle:="Select a *.csv with Traffic Counts to Import:", _
                    initialDir:=MAIN.initialDir, _
                    Flags:=ahtOFN_READONLY)' Verify Entry
    If IsNull(filePath) Or filePath = "" Then
        GoTo addLibrary_Error
    End If' Set the file path
    MAIN.initialDir = Left(filePath, InStrRev(filePath, "\"))
    tFileName.Text = filePath' Populate the listview
    populateListView

    Exit Sub

addLibrary_Error:
    MsgBox ("Please Select a valid *.csv File.  Contact Jon Nicholson with questions.")
End Sub' Populate the rows of the list view
Public Sub populateListView()' Clear existing Items
    CountListView.ListItems.Clear' Open File into Stream
    Dim strTextLine As String
    Dim headerHit As Integer: headerHit = 0
    Dim fso As FileSystemObject: Set fso = New FileSystemObject
    Set txtStream = fso.OpenTextFile(filePath, ForReading, False)

    Do While Not txtStream.AtEndOfStream
        strTextLine = txtStream.ReadLine

        With CountListView
            If headerHit = 1 Then
                ' Add the counts Line by Line
                Dim lArr() As String
                lArr = Split(strTextLine, ",")

                Dim li As ListItem

                Set li = .ListItems.Add(Text:=lArr(0))
                li.ListSubItems.Add , , lArr(1)
                li.ListSubItems.Add , , lArr(2)
                li.ListSubItems.Add , , lArr(3)
            Else
                ' Skip the CSV Header
                headerHit = 1
            End If

        End With

    Loop
    txtStream.Close
End Sub

' Replace in CAD
Private Sub bImplementCAD_Click()
    Dim i As Integer
    For i = 1 To CountListView.ListItems.Count
        Dim findText As String: findText = CountListView.ListItems.Item(i)
        Dim AM As String: AM = CountListView.ListItems.Item(i).SubItems(1)
        Dim PM As String: PM = CountListView.ListItems.Item(i).SubItems(2)
        Dim DAILY As String: DAILY = CountListView.ListItems.Item(i).SubItems(3)

        Dim ReplaceText As String: ReplaceText = AM & vbNewLine & "(" & PM & ")"

        Call Process.findReplaceText(findText, ReplaceText)
    Next
End Sub

' Initialize the List Box
Private Sub UserForm_Initialize()
    With CountListView
       .view = lvwReport
       .Checkboxes = False
       .FullRowSelect = True
       .GridLines = True
       With .ColumnHeaders
          .Clear
          .Add , , "Movement ID", 60
          .Add , , "AM Count", 60
          .Add , , "PM Count", 60
          .Add , , "Daily", 60
       End With
    End With

End Sub

Text Replacement Class

Option Explicit' Searches in text strings and nested cells

    Private sToFind As String       ' Find text
    Private sToReplace As String    ' Replace with this text
Sub findReplaceText(strIn As String, strOut As String)
    Dim Ee As ElementEnumerator
    Dim Sc As New ElementScanCriteria

    sToFind = strIn
    sToReplace = strOut

    Sc.ExcludeAllTypes
    Sc.IncludeType msdElementTypeText
    Sc.IncludeType msdElementTypeTextNode

    Set Ee = ActiveModelReference.Scan(Sc)
    ' Browse current model and start the test routine:
    Do While Ee.MoveNext
        Call complexSearch(Ee.Current)
    Loop
End Sub' Subroutine for recursively browsing nested complex elements
Sub complexSearch(oEle As Element)
    Dim EeSub As ElementEnumerator' If a complex element or text node is found, check all sub-elements:
    If (oEle.IsComplexElement) Or (oEle.Type = msdElementTypeTextNode) Then
        Set EeSub = oEle.AsComplexElement.GetSubElements
        Do While EeSub.MoveNext
            Call complexSearch(EeSub.Current)
        Loop' Otherwise string compare, if a text is present:
    Else
        If oEle.Type = msdElementTypeText Then
            If InStr(oEle.AsTextElement.Text, sToFind, vbTextCompare) > 0 Then
                MsgBox (oEle.AsTextElement.Text)
               oEle.AsTextElement.Text = sToReplace
               oEle.Rewrite
            End If
        End If
    End If
End Sub

I would greatly appreciate any help getting this resolved!!

~Matt


Viewing all articles
Browse latest Browse all 7260

Trending Articles