Author Topic: Adding/Updating Filename in Text (Microstation)  (Read 6490 times)

0 Members and 1 Guest are viewing this topic.

jvillarreal

  • Bull Frog
  • Posts: 332
Adding/Updating Filename in Text (Microstation)
« 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
Code: [Select]
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
« Last Edit: December 07, 2010, 01:15:34 PM by jvillarreal »

caddcop

  • Guest
Re: Adding/Updating Filename in Text (Microstation)
« Reply #1 on: December 07, 2010, 04:09:55 PM »
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.

jvillarreal

  • Bull Frog
  • Posts: 332
Re: Adding/Updating Filename in Text (Microstation)
« Reply #2 on: December 07, 2010, 04:47:12 PM »
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.
« Last Edit: December 07, 2010, 05:02:38 PM by jvillarreal »

jvillarreal

  • Bull Frog
  • Posts: 332
Re: Adding/Updating Filename in Text (Microstation)
« Reply #3 on: December 10, 2010, 09:05:02 AM »
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
Quote
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