Produkt(e):	MicroStation
	Version(en):	08.11.09.829
	Umgebung:	Windows 8
	Produktbereich:	Programmierung
	Produktunterbereich:	VBA

 

Hintergrundinformation

 Bei der Weiterverarbeitung von ehemaligen DWG Dateien kann es wünschenswert oder sogar notwendig sein, dass bestimmte sogenannte assoziative Bereiche in komplexe Flächen konvertiert werden.
Man kann dazu den Tastaturbefehl "create shape icon" verwenden, jedoch werden dabei nur einzelne Elemente unterstützt. Der Grund hierfür ist, dass nicht der eigentliche assoziative Bereich gewählt werden muss, sondern der für die Kontur verwendete Linestring, der als Unterelement des Bereichs definiert ist.

Erforderliche Schritte

Um jedoch auch eine größere Anzahl von solchen Bereichen zu wandeln, bietet es sich an dies mit VBA auszuführen, um die Wahl des Linestrings zu automatisieren.

Hier möchste ich ein Beispiel vorstellen, wie man dabei vorgehen könnte. Zu beachten ist hier, dass der assoziative Bereich jeweils entfernt wird. Sollte dies nicht gewünscht sein, muß nur die Zeile:

ActiveModelReference.RemoveElement Ee.Current

aus dem Beispielcode entfernt werden.

 

Sub assoc2shape()
Dim Ee As ElementEnumerator
Dim eeSub As ElementEnumerator
Dim eesub1 As ElementEnumerator
Dim pSelect As Point3d
Dim vert() As Point3d
Dim ele As Element

' wenn vorab Elemente gewählt werden, werden nur diese verarbeitet, ansonsten alle:
Set Ee = ActiveModelReference.GetSelectedElements
If Not (Ee.MoveNext) Then
    Set Ee = ActiveModelReference.GraphicalElementCache.Scan
Else
    Ee.Reset
End If
Do While Ee.MoveNext
    If Ee.Current.Type = msdElementTypeCellHeader Then
        ' assoziative Bereiche werden als Typ 2 Zellen mit festem Namen repräsentiert:
        If Ee.Current.AsCellElement.Name = "DWG Hatch: SOLID" Then
            Set eeSub = Ee.Current.AsCellElement.GetSubElements
            Do While eeSub.MoveNext
                If eeSub.Current.IsComplexShapeElement Then
                  Set eesub1 = eeSub.Current.AsComplexShapeElement.GetSubElements
                  Do While eesub1.MoveNext
                    If eesub1.Current.IsVertexList Then
                        Set ele = eesub1.Current
                        vert = eesub1.Current.AsVertexList.GetVertices
                    End If
                  Loop
                End If
            Loop
            ' Komplexen Bereich erstellen und vorigen assoziativen Bereich entfernen:
            If UBound(vert) - LBound(vert) >= 0 Then
                pSelect = vert(LBound(vert))
                CadInputQueue.SendCommand "create shape icon"
                CadInputQueue.SendDataPointForLocate ele, pSelect
                CadInputQueue.SendDataPoint pSelect
                CadInputQueue.SendDataPoint pSelect
                CommandState.StartDefaultCommand
                ActiveModelReference.UnselectAllElements
                ActiveModelReference.RemoveElement Ee.Current   ' assoziativen Bereich entfernen
            End If
        End If
    End If
Loop
End Sub

 

 

 

Ursprünglicher Autor:

Artur Goldsweer