Die Oberflächen von Smartsolids können mit der Methode .FacetSolidAsShapes extrahiert werden. Diese Flächen könnte man beispielsweise in die Zeichnung hinzufügen, um die Positionen und Größe zu vergleichen.Befindet sich das SmartSolid Element jedoch nicht am Nullpunkt, so erkennt man beim Zoom leichte Ungenauigkeiten, die möglicherweise durch Rundungen der Werte ergeben. Die Ungenauigkeit ist auch dann vorhanden, wenn sich das SmartSolid innerhalb des SWA (Solid Working Area) befindet.Hier ein Beispiel, wie man solche Shapes aus SmartSolids extrahieren und in die Zeichnung hinzufügen könnte:
' etwas ungenaues Ergebnis: Sub extractshapefromsolid_ungenau() Dim Enumerator As ElementEnumerator Dim enumShapes As ElementEnumerator Dim Sc As New ElementScanCriteria Sc.ExcludeAllTypes Sc.IncludeType msdElementTypeCellHeader Set Enumerator = ActiveModelReference.GraphicalElementCache.Scan Do While Enumerator.MoveNext If Enumerator.Current.IsSmartSolidElement Then 'Extrahieren aller Shapes aus dem SmartSolid: Set enumShapes = Enumerator.Current.AsSmartSolidElement.FacetSolidAsShapes(100, 1000, 1000, 2 * Pi) Do While enumShapes.MoveNext ' Shapes zum Vergleichen gefüllt darstellen enumShapes.Current.AsClosedElement.FillMode = msdFillModeFilled ' Shape in die Zeichnung einfügen: ActiveModelReference.AddElement enumShapes.Current enumShapes.Current.Color = 3 ' die extrahierten Shapes liegen am Nullpunkt und müssen zum SmartSolid geschoben werden, um die Positionen vergleichen zu können: enumShapes.Current.Move Enumerator.Current.AsSmartSolidElement.Origin ' die Verschiebung speichern: enumShapes.Current.Rewrite Loop End If Loop End Sub
Gehen wir einmal von einem solchen einfachen SmartSolid aus:
Dann erzeugt die obige Routine Shapes, wobei man an den Ecken leichte Ungenauigkeiten erkennen kann.Die Shapes sind hier rot gefüllt dargestellt:
Ein tiefer Zoom zeigt dies etwas deutlicher:
Verscheibt man for dem Extrahieren dieses SmartSolid Element zum Nullpunkt, ist das Ergebnis exakt, so könnte das Beipiel geändert werden, damit es exakte Ergebnisse liefert:
'Lösung: Sub extractshapefromsolid_exact() Dim Enumerator As ElementEnumerator Dim enumShapes As ElementEnumerator Dim Sc As New ElementScanCriteria Dim pOrigin As Point3d Dim pOriginTemp As Point3d Sc.ExcludeAllTypes Sc.IncludeType msdElementTypeCellHeader Set Enumerator = ActiveModelReference.GraphicalElementCache.Scan Do While Enumerator.MoveNext If Enumerator.Current.IsSmartSolidElement Then pOrigin = Enumerator.Current.AsSmartSolidElement.Origin pOriginTemp.x = -pOrigin.x pOriginTemp.y = -pOrigin.y pOriginTemp.Z = -pOrigin.Z ' temporäres Verschieben des Smartsolids vor dem Extrahieren der Shapes ' dies muss nicht rückgängig gemacht werden, da die Verschiebung nur ' temporär erfolgt und nicht in der Zeichung gespeichert wird: Enumerator.Current.Move pOriginTemp Set enumShapes = Enumerator.Current.AsSmartSolidElement.FacetSolidAsShapes(100, 1000, 1000, 2 * Pi) Do While enumShapes.MoveNext enumShapes.Current.AsClosedElement.FillMode = msdFillModeFilled ActiveModelReference.AddElement enumShapes.Current enumShapes.Current.Color = 1 ' die Shapes müssen an dieselbe Position verschoben werden, ' der Wert dafür muss jetzt zwischengespeichert werden, ' da das SmartSolid zwischendurch temporär verschoben wurde: enumShapes.Current.Move pOrigin enumShapes.Current.Rewrite Loop End If Loop End Sub
Das exakte Ergebnis ist in blau dargestellt, hier der Vergleich: