Beim Import von Koordinaten können diese oft durch Punkte dargestellt werden. Der Nachteil dabei ist, dass diese in der Zeichnung schwer optisch zu identifizieren sind.Wünschenswert wäre deshalb eine alternative Darstellung der Punkte durch einen anderen Elementtyp.
Ich möchte deshalb hier eine kleine Routine zeigen, mit der in einem Schritt alle Punkte durch beispielsweise Kreise ersetzt werden.Die Größe der Kreise ist im Programm festgelegt und kann leicht auf eigene Bedürfnisse angepasst werden.Die Punkte werden in MicroStation durch Linien der Länge 0 dargestellt, d.h. die Vorgehensweise ist in dem Beispiel so, dass zunächst alle Linien in der Zeichnung gesucht werden.Anschließend wird die Länge dieser Linien überprüft und alle Linien der Länge 0 werden durch Kreise ersetzt.
Hier jetzt das Beispiel:
Sub line2circle() Dim Ee As ElementEnumerator Dim Sc As New ElementScanCriteria Dim Anzahl As Long ' Zähler der gelöschten Elemente Dim oCirc As EllipseElement ' Ellipse (Kreis ist Spezialfall einer Ellipse) definieren zum Austausch für Punkte: Dim oElli As Ellipse3d oElli.Vector0 = Point3dFromXYZ(0, 0.5, 0) oElli.Vector90 = Point3dFromXYZ(0.5, 0, 0) oElli.Start = 0 oElli.Sweep = 2 * Pi ' Punkte = Linien der Länge 0, nur Linien gesucht und geprüft: Sc.ExcludeAllTypes Sc.IncludeType msdElementTypeLine Set Ee = ActiveModelReference.Scan(Sc) Do While Ee.MoveNext If Ee.Current.AsLineElement.Length = 0 Then oElli.Center = Ee.Current.AsLineElement.startPoint Set oCirc = CreateEllipticalElement1(Nothing, oElli, msdFillModeNotFilled) ActiveModelReference.AddElement oCirc ActiveModelReference.RemoveElement Ee.Current End If Loop MessageCenter.AddMessage "Es wurden " + str(Anzahl) + " Linien durch Kreise ersetzt", , msdMessageCenterPriorityInfo End Sub
Nach dem Austasuch der Punkte erfolgt eine kurze Meldung in der Nachrichtenzentrale, wieviele Linien ersetzt wurden.
Mit VBA Linien Länge 0 löschen