Bezieht sich auf
	Produkt(e):	MicroStation
	Version(en):	08.11.09.578
	Umgebung:	Windows 7 64 bit
	Produktbereich:	Programmierung
	Produktunterbereich:	VBA
	Ursprünglicher Autor:	Artur Goldsweer, Bentley Technical Support Group

Hintergrundinformation

Es kann für verschiedene Anwendungen sinnvoll sein, dass alle in einer Zeichnung vorhandenen Elemente eines Typs auf einer gemeinsamen Ebene liegen.
Da dies manuell mühsam sein kann, ist eine Unterstützung durch ein kleines Tool sinnvoll.

Erforderliche Schritte

Im folgenden zeige ich an einem kleinen Beispiel, wie man mit einem VBA Tool alle Texte eines Modells auf eine neue Ebene legt und vorab diese neue Ebene anlegt, falls sie noch nicht vorhanden.

Für die Prüfung der Existenz einer Ebene benutze ich eine Hilfsfunktion "LevelExist", deren Rückgabewert true oder false ist, je nachdem ob es eine Ebenen mit dem gesuchten Namen bereits gibt.

Der Aufruf des Tools erfolgt über die Subroutine "Texte_auf_level", die man direkt starten kann ohne weitere Angabe eines Parameters. In dem Fall wird eine fest im Code eingetragene Ebene mit dem Namen "LevelDerTexte" verwendet. Alternativ gibt man den Namen der Ebene für die Texte als Aufrufparameter beim Start der VBA Routine mit.
Wenn die .mvba Projektdatei geladen ist, kann folgender Keyin verwendet werden:

vba run Texte_aufLevel NeuerName

Dann wird der Paremeter "NeuerName" als Name für eine neu anzulegende Ebene verwendet.

Hier nun das Beispiel, wie man dies machen könnte:

' Hilfsfunktion zum Prüfen der Existenz einer Ebene
Private Function LevelExist(LevelName As String) As Boolean
    Dim oLv As Level
    LevelExist = False
    For Each oLv In ActiveDesignFile.Levels
        If UCase(oLv.Name) = UCase(LevelName) Then
            LevelExist = True
            Exit Function
        End If
    Next
End Function

Sub Texte_auf_level()
    Dim oLv As Level
    Dim neuerLevel As String
    ' Prüfen ob neuer Name als Parameter beim Aufruf mitgegeben wurde:
    neuerLevel = KeyinArguments
    
    ' Falls kein Parameter mitgegeben wurde, dann "LevelDerTexte" verwenden:
    If Len(Trim(neuerLevel)) = 0 Then
        neuerLevel = "LevelDerTexte"
    End If
    
    ' Falls der neue Levelname noch nicht existiert, dann Level anlegen:
    If Not LevelExist(neuerLevel) Then
        ActiveDesignFile.AddNewLevel neuerLevel
    End If
    Set oLv = ActiveDesignFile.Levels(neuerLevel)
    
    ' Jetzt alle Texte suchen und auf neuen Level verschieben:
    Dim Ee As ElementEnumerator
    Dim Sc As New ElementScanCriteria
    Sc.ExcludeAllTypes
    Sc.IncludeType msdElementTypeText
    Set Ee = ActiveModelReference.Scan(Sc)
    Do While Ee.MoveNext
        Set Ee.Current.Level = oLv
        Ee.Current.Rewrite
    Loop
End Sub

Diese Vorgehensweise kann auch in Verbindung mit der Vergabe von Prioritäten für Ebenen verwendet werden, um sicher zu gehen, dass beispielsweise Texte immer sichtbar sind:

Sehen Sie hierzu auch

Darstellungsreihenfolge der Ebenen ändern