Dim swApp As SldWorks.SldWorks Type DoubleRec dValue As Double End Type Type Long2Rec iLower As Long iUpper As Long End Type Sub main() ' Notwendige Deklarationen der Variablen und Objekte Dim sInDoc As SldWorks.ModelDoc2 Dim sFace As SldWorks.Face2, sEdge As SldWorks.Edge, sSelMgr As SldWorks.SelectionMgr Dim Edges As Variant, i As Integer, CPar As Variant, iLower As Long, iUpper As Long Dim s As String, sCPar(10) As String, j As Integer ' Objektvariablen setzen Set swApp = Application.SldWorks Set sInDoc = swApp.ActiveDoc If sInDoc Is Nothing Then ' Prüfen, ob Dokument vorhanden MsgBox "Kein SolidWorks Dokument." End End If Set sSelMgr = sInDoc.SelectionManager If sSelMgr.GetSelectedObjectCount = 0 Then ' Prüfen, ob was ausgewählt ist MsgBox "Nichts ausgewählt." End End If If sSelMgr.GetSelectedObjectType2(1) <> 2 Then ' Prüfen ob ausgewähltes Ding ein Face ist MsgBox "Auswahl ist keine Fläche (Face)." End Else ' Nachfolgender Programmteil wird nur bei fehlerfreier Eingabe durchlaufen Set sFace = sSelMgr.GetSelectedObject6(1, -1) ' Objektvariable des ausgewählen Face setzen ... Edges = sFace.GetEdges ' und alle Edges speichern (als Objekte) s = "" ' in s wird die Ausgabe gespeichert For i = 1 To sFace.GetEdgeCount ' GetEdgeCount gibt die Anzahl der Edges an ' die FOR Schleife durchläuft die Werte i=1...Anzahl Edges ' und endet bei der Zeile "Next i" Set sEdge = Edges(i - 1) ' Objektvariable der jetzigen Edge setzen und die ... CPar = sEdge.GetCurveParams2 ' Parameterwerte abspeichern. Beschreibung: ' Auf Wort GetCurveParams2 ein Doppelclick, F1 drücken For j = 0 To 7 ' Diese und nachfolgende 2 Zeilen für bessere Lesbarkeit ... sCPar(j) = Format(CPar(j), "###0.000") ' der Ausgabe Next j s = s & "Nr. " & i & " Start (" & sCPar(0) & "," & sCPar(1) & "," & sCPar(2) & ") Ende (" & sCPar(3) & _ "," & sCPar(4) & "," & sCPar(5) ' Start- und Endpunkt der jetzigen Edge als (x,y,z)-Wert s = s & ") Par " & sCPar(6) & " " & sCPar(7) ' Werte Start- und Ende Parameterdarstellung. Ein vollständiger ' Kreisbogen z. B. 0 bis 6.2831 (2Pi) ExtractFields CPar(8), iLower, iUpper ' notwendig wg. Packen von 2 16Bit Zahlen in eine Variable s = s & " Typ " & iUpper - 3000 ' (SolidWorks historisch bedingt). Typ gibt Art der Edge an: ' 1:Strecke, 2:Kreisbogen, 3:Ellipse ... ExtractFields CPar(9), iLower, iUpper s = s & " Name " & iUpper ExtractFields CPar(10), iLower, iUpper s = s & " R/L " & iUpper & Chr(13) Next i MsgBox s ' Ergebnisse anzeigen End If End Sub ' das wars. Function ExtractFields(ByVal dValue As Double, iLower As Long, iUpper As Long) Dim dr As DoubleRec Dim i2r As Long2Rec dr.dValue = dValue LSet i2r = dr iLower = i2r.iLower iUpper = i2r.iUpper End Function