I needed a way to automatically add/update text containing filenames in microstation drawings. This is to aid use of a pentable created in excel for text substitutions. The office is using v8 and xm with no plan to utilize newer versions anytime soon.
I looked up some code examples and put this together which works...It scans the dgn for text (containing ".dgn") to update with new filename and if it isn't found, it scans attached reference files for the text to copy and update.
This is the first vba code i've put together and i'm curious how it can be shortened or written more efficiently. I'd like to continue learning microstation vba for v8/xm and this would be a helpful example. All help/suggestions will be appreciated. Thanks in advance, Juan
Sub AddFileName()
Dim ee As ElementEnumerator
Dim esc As ElementScanCriteria
Dim oAttach As Attachment
Dim oTextele As TextElement
Dim CopiedElement As TextElement
Dim path As String
Dim NewStr As String
Set esc = New ElementScanCriteria
path = GetDgnFileName(ActiveModelReference)
esc.ExcludeAllTypes
esc.IncludeType msdElementTypeText
esc.IncludeType msdElementTypeTextNode
Set ee = ActiveModelReference.Scan(esc)
Do While ee.MoveNext
If ee.Current.IsTextElement Then
Set oTextele = ee.Current
If InStr(1, oTextele.Text, ".dgn", vbTextCompare) Then
If Not (NewStr = path) Then
Set CopiedElement = oTextele
NewStr = CopiedElement.Text
NewStr = Replace(NewStr, NewStr, path)
CopiedElement.Text = NewStr
CopiedElement.Rewrite
End If
End If
End If
Loop
For Each oAttach In ActiveModelReference.Attachments
Set ee = oAttach.Scan(esc)
Do While ee.MoveNext
If ee.Current.IsTextElement Then
Set oTextele = ee.Current
If InStr(1, oTextele.Text, ".dgn", vbTextCompare) Then
If Not (NewStr = path) Then
Set CopiedElement = ActiveModelReference.CopyElement(oTextele)
NewStr = CopiedElement.Text
NewStr = Replace(NewStr, NewStr, path)
CopiedElement.Text = NewStr
CopiedElement.Rewrite
End If
End If
End If
Loop
Next
End Sub