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