TheSwamp
Code Red => VB(A) => Topic started by: jvillarreal on December 07, 2010, 12:59:55 PM
-
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
-
Without commenting on your code, is there any reason not to use the text substitution feature of pen tables? I just worked on a local DOT project and in their sheet border were some distinct text strings, like $username$ and $dgnname$ and their plot driver automatically calls up their pentable which automatically replaces those with the full path filename and my Windows username.
I do nkow that the text string must be an exact match. In other words, you cannot have this as the string:
FILE: $dgnname$
unless the FILE: part is one piece of text and $dgnname$ is a separate piece of text.
-
Thanks for the response.
Let me explain the situation a little more:
We use a pentable for text substitutions already (including $dgn$ placed at the top of the border). But in order to update sheet numbers we substitute actual file name. The text must contain the file name, as it can not substitute another text substitution string.
Ex: Lets say the filename is drawing1.dgn
"$dgn$" prints as "drawing1.dgn" with the pentable
"drawing1.dgn" prints as "1" with the pentable
What this code does, is search for a string containing ".dgn" to update or copy/update with the current filename for use with the pen table. You can imagine how helpful this can be if used on projects containing a couple hundred drawings.
-
For the minority of microstation users at this site...
Here's a reply I got from the 'MicroStation V8 2004 Edition - VBA' forum over at communities.bentley.com
Posted by Jon Summers on Fri, Dec 10 2010 8:59 AM
Re: Adding/Updating Filename in text
ˇBienvenidos!
For a first attempt, that's excellent! One rule to apply is simple: if the code fits on a single page of paper (or on a single screen) and it works, then there's no more to be done.
One thing you could do is move the scan logic into a procedure. You currently repeat the code for the ActiveModelReference and each Attachment, so the code is duplicated.
Private Function UpdateText (ByVal oModel As ModelReference, ByVal newStr As String, ByVal path As String) As Integer
UpdateText = 0
Dim nReplacements As Integer
Dim ee As ElementEnumerator
Dim esc As ElementScanCriteria
Dim oText As TextElement
Dim oCopy As TextElement
Set esc = New ElementScanCriteria
esc.ExcludeAllTypes
esc.IncludeType msdElementTypeText
esc.IncludeType msdElementTypeTextNode
Dim bIsReference As Boolean
bIsReference = oModel.IsAttachment
Set ee = oModel.Scan(esc)
Do While ee.MoveNext
If ee.Current.IsTextElement Then
Set oText = ee.Current
If InStr(1, oText.Text, ".dgn", vbTextCompare) Then
If Not (NewStr = path) Then
If (bIsReference) Then
Set oCopy = oText.Clone
NewStr = oCopy.Text
NewStr = Replace(NewStr, NewStr, path)
oCopy.Text = NewStr
ActiveModelReference.AddElement oCopy
Else
Set oCopy = oText
NewStr = oCopy.Text
NewStr = Replace(NewStr, NewStr, path)
oCopy.Text = NewStr
oCopy.Rewrite
EndIf
nReplacements = 1 + nReplacements
End If
End If
End If
Loop
UpdateText = nReplacements
End Function
Regards, Jon Summers
LA Solutions