Mit VBA Referenzpfade ändern


 Produkt(e):MicroStation
 Version(en):08.11.09.578 und 10.00.00.25
 Umgebung:Windows 8
 Produktbereich:Programmierung
 Produktunterbereich:VBA

Hintergrundinformation

Mit Hilfe von VBA ist es möglich auf die Eigenschaften von Referenzdateien zuzugreifen und zu modifizieren. Dies kann auch dazu verwendet werden, um den Speicherort von Referenzn zu verändern. Dies ist eine durchaus häufig notwendige Maßnahme bei Zeichnungsdateien, da sich aufgrund von Strukturänderungen die Pfade zu den Referenzdateien ändern können.

Wie schon in einem vorigen Beitrag: Mit VBA den Pfad zu ausgeschalteten Referenzen auslesen
beschrieben, kann man durchaus auf den Pfad von Referenzdateien zugreifen.

Erforderliche Schritte

Beim Ändern eines Referenzpfades muss darauf geachtet werden, dass bei fehlenden oder ausgeschalteten Referenzen der vollständige Pfad in VBA nicht bzw. nur über Umwegen zur Verfügung steht.
Ein neuer Pfad kann dann aus dem alten Pfad zusammengestellt und mit der Methode .SetAttachNameDeferred  aktualisiert werden.

Ein möglicher Ansatz für eine solche Aufgabe kann folgendes Beispiel bilden. Dabei muss diesee Routine mit zwei Parametern aufgerufen werden:
Parameter1 : der zu ersetzende linke Teil des Referenzpfades
Parameter2: der neue linke Teil des Referenzpfades

Der Aufruf der Routine lautet dann:
vba run refpfadaendern Parameter1 Parameter2

Beispiel können sein:

vba run refpfadaendern c: d:

vba run refpfadaendern c:\Pfad_alt\ x:\Pfad_neu\verschachtelt\


Hier das Beispiel, das als Ansatz verwendet werden könnte:

Declare Function mdlRefFile_getParameters Lib "stdmdlbltin.dll" (ByVal param As String, ByVal paramName As Long, ByVal modelRef As Long) As Long

Const REFERENCE_FILENAME = 7

Sub refpfadaendern()
Dim oatts As Attachments
Dim oAtt As Attachment
Dim zeile As String
Dim alt As String
Dim neu As String
Dim p() As String
Dim i As Integer
Dim sum As Integer
Dim strFullName As String

strFullName = Space(512)
sum = 0
zeile = KeyinArguments
p = Split(zeile)
If UBound(p) - LBound(p) <> 1 Then
    MsgBox "Bitte genau 2 Parameter mitgeben: 'alter Wert' und 'neuer Wert'", vbCritical
    Exit Sub
Else

    alt = Trim$(p(LBound(p)))
    neu = Trim$(p(UBound(p)))

    Set oatts = ActiveModelReference.Attachments
    For Each oAtt In oatts

        Dim rtc As Long
        Dim charP As Long

        strFullName = Space(512)
        rtc = mdlRefFile_getParameters(strFullName, REFERENCE_FILENAME, oAtt.MdlModelRefP)
        If rtc = 0 Then
         If Len(strFullName) > 0 Then
         strFullName = Left$(strFullName, InStr(1, strFullName, vbNullChar) - 1)
        
         zeile = strFullName
         If zeile = "" Then zeile = oAtt.AttachName
        
         i = InStr(UCase$(zeile), UCase$(alt))
         If i = 1 Then
                zeile = neu + Right$(zeile, Len(zeile) - Len(alt))
                oAtt.SetAttachNameDeferred (zeile)
                oAtt.Rewrite
                sum = sum + 1
         End If
       End If
     End If
    Next
End If
ShowStatus "Es wurden " + str(sum) + " Referenzen aktualisiert"
End Sub


Ergänzung für die Verwendung in MicroStation Connect Edition x64

Durch den Wechsel von V8i zu V10 und dem damit verbundenen Wechsel von 32 auf 64 Bit sind auch in dem VBA Beispiel Anpassungen vorzunehmen, um das Beispiel auch in V10 benutzen zu können.

Hier zunächst das überarbeitete Beispiel und im Anschluß weitere Details zu den Änderungen:

'Bedingte Deklaration der Funktion in Abhängigkeit der VBA Version:
#If VBA7 Then
Public Declare PtrSafe Function mdlRefFile_getStringParameters Lib "stdmdlbltin.dll" (ByVal value As String, ByVal maxChars As Long, ByVal paramName As Long, ByVal modelRef As LongLong) As Long
#Else
Public Declare Function mdlRefFile_getParameters Lib "stdmdlbltin.dll" (ByVal param As String, ByVal paramName As Long, ByVal modelRef As Long) As Long
#End If
Public Const REFERENCE_FILENAME = 7


Sub refPfadAendern()
Dim oatts As Attachments
Dim oAtt As Attachment
Dim oMods As ModelReferences
Dim oMod As ModelReference
Dim zeile As String
Dim alt As String
Dim neu As String
Dim p() As String
Dim i As Integer
Dim sum As Integer
Dim strFullName As String

strFullName = Space(512)
sum = 0
zeile = KeyinArguments
p = Split(zeile)
If UBound(p) - LBound(p) <> 1 Then
    MsgBox "Bitte genau 2 Parameter mitgeben: 'alter Wert' und 'neuer Wert'", vbCritical
    Exit Sub
Else

    alt = Trim$(p(LBound(p)))
    neu = Trim$(p(UBound(p)))

    Set oatts = ActiveModelReference.Attachments
    For Each oAtt In oatts

        Dim rtc As Long
        Dim charP As Long

        strFullName = Space(512)
                

        ' Bedingte Ausführung je nach VBA Version:
        #If VBA7 Then
        rtc = mdlRefFile_getStringParameters(strFullName, Len(strFullName), REFERENCE_FILENAME, oAtt.MdlModelRefP)
        #Else
        rtc = mdlRefFile_getParameters(strFullName, REFERENCE_FILENAME, oAtt.MdlModelRefP)
        #End If
        If rtc = 0 Then
         If Len(strFullName) > 0 Then
         strFullName = Left$(strFullName, InStr(1, strFullName, vbNullChar) - 1)
        
         zeile = strFullName
         If zeile = "" Then zeile = oAtt.AttachName
        
         i = InStr(UCase$(zeile), UCase$(alt))
         If i = 1 Then
                zeile = neu + Right$(zeile, Len(zeile) - Len(alt))
                oAtt.SetAttachNameDeferred (zeile)
                oAtt.Rewrite
                sum = sum + 1
         End If
       End If
     End If
    Next
End If
ShowStatus "Es wurden " + str(sum) + " Referenzen aktualisiert"
End Sub

Im Wesentlichen haben sich 2 Punkte geändert, und zwar generell die Art der Deklaration einer Funktion aus einer DLL und speziell hier in diesem Besipiel die Änderung des Namens der Funktion verbunden mit einer geänderten Anzahl von Parametern und Typen.

Deklaration der Funktion aus der DLL:

V8i:

Public Declare Function mdlRefFile_getParameters Lib "stdmdlbltin.dll" (ByVal param As String, ByVal paramName As Long, ByVal modelRef As Long) As Long

V10:

Public Declare PtrSafe Function mdlRefFile_getStringParameters Lib "stdmdlbltin.dll" (ByVal value As String, ByVal maxChars As Long, ByVal paramName As Long, ByVal modelRef As LongLong) As Long

Der Aufruf der Funktion im VBA muss entsprechend angepasst werden:

V8i:
        rtc = mdlRefFile_getParameters(strFullName, REFERENCE_FILENAME, oAtt.MdlModelRefP)

V10:
        rtc = mdlRefFile_getStringParameters(strFullName, Len(strFullName), REFERENCE_FILENAME, oAtt.MdlModelRefP)

In dem Beispiel benutze ich die bedingte Verwendung jeweils in Abhängigkeit der Variablen VBA7.
Diese Variable VBA7 ist mit der VBA Version 7 eingeführt worden, die in der MicroStation Connect Version verwendet wird.
Details dazu und auch über Änderungen der Deklaration wie Einführung von PtrSafe und LongLong sind in der VBA Hilfe detailliert beschrieben.  

Sehen Sie hierzu auch

Mit VBA den Pfad zu ausgeschalteten Referenzen auslesen

 Ursprünglicher Autor:Artur Goldsweer