Produkt(e):	MicroStation
	Version(en):	V8i oder CONNECT
	Umgebung:	Windows 8, 10
	Produktbereich:	Programmierung
	Produktunterbereich:	VBA

Hintergrundinformation

Es ist möglich im ACS Manager Koordinatensysteme aus anderen DGN Dateien zu importieren. Dieser Vorgang kann auch per VBA aufgezeichnet werden, um diesen Vorgang zu automatisieren.
Allerdings ist der aufgezeichnete VBA Code nicht vollständig, denn für die Auswahl eines ACS in einer anderen Datei sind die Angaben der Datei, des Modells und der Name des zu importierenden ACS notwendig.
Und diese Angaben fehlen, wenn der Code aufgezeichnet wird.

VBA bietet jedoch im Objektkatalog Methoden an, mit denen dieser Vorgang auch durchgeführt werden kann, ich möchte hier ein Beispiel zeigen, wie dies mit VBA erreicht werden kann.
Dazu verwende ich folgende Schritte:

- Öffnen der Datei für Programmierung, die das gesuchte ACS enthält. Die aktive Datei bleibt dabei geöffnet, dieser Schritt ist für den Anwender nicht sichtbar.
- Suchen des gewünschten ACS im richtigen Modell
- Wenn gefunden, dann wird dieses ACS in die aktive Datei kopiert.

Hier der VBA Ansatz dazu, wie man dies erreichen könnte. Es wird hier im konkreten Beispiel angenommen, dass beide DGN Dateien im selben Verzeichnis liegen, dies kann natürlich alles beliebig den eigen Wünschen angepasst werden.

Option Explicit

Sub importACS()
Dim sPath As String
Dim oWorkDgn As DesignFile
Dim oMod As ModelReference
Dim oMods As ModelReferences
Dim ee As ElementEnumerator
Dim bFound As Boolean
Dim oACS As AuxiliaryCoordinateSystemElement
Dim oCC As CopyContext
    
    sPath = ActiveDesignFile.Path  ' Pfad zur aktiven Datei
    Set oWorkDgn = OpenDesignFileForProgram(sPath + "/" + "acsfrom.dgn", True)  'Dateiname der DGN, in der das ACS gesucht wird
   
    Set oMod = oWorkDgn.Models("3D Metric Design") ' Modell in dem nach dem ACS gesucht wird
    If Not oMod Is Nothing Then
        Set ee = oMod.ControlElementCache.Scan()
        bFound = False
        Do While ee.MoveNext
            If ee.Current.IsAuxiliaryCoordinateSystemElement Then
                If ee.Current.AsAuxiliaryCoordinateSystemElement.Name = "test1" Then ' Name des gesuchten ACS
                    Set oACS = ee.Current.AsAuxiliaryCoordinateSystemElement
                    bFound = True
                    Exit Do
                End If
            End If
        Loop
        If bFound Then
            ActiveModelReference.CopyElement oACS, oCC
        End If
    End If
    oWorkDgn.Close
End Sub