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 auslesenbeschrieben, kann man durchaus auf den Pfad von Referenzdateien zugreifen.
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 ReferenzpfadesParameter2: 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
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.
Mit VBA den Pfad zu ausgeschalteten Referenzen auslesen