Hallo Perta!
Hatte vor kurzer Zeit ein ähnliches Problem, damals wollte ich Geometrie auf einer Oberfläche greifen.
Hierzu bin ich über den Loop, also den Kantenzug gegangen!
Hierzu gibt es in der API-Hilfe folgendes Beispiel:
Select Loop of Edges Example (VB)
This example shows how to use various geometry- and topology-related APIs to select a set of edges that form a closed loop around a face.
'------------------------------------------------------------------
'
' Problem:
' In the SolidWorks user-interface for parts and assemblies,
' you can select an option to select a set of edges that form
' a closed loop exists. If there is a choice of loops, an icon is
' displayed to allow choosing between the alternatives.
' In general, there is a choice if the edge is
' shared between two faces, as in an edge on a solid
' body.
'
' Preconditions:
' (1) Part or assembly is open.
' (2) Edge is the first selected item.
' (3) Optionally, a face, adjacent to the edge
' is the second selected item.
'
' Postconditions: Loop of edges on face is selected.
'
'------------------------------------------------------------------
Option Explicit
Sub SelectLoop _
( _
swApp As SldWorks.SldWorks, _
swModel As SldWorks.ModelDoc2, _
swLoop As SldWorks.Loop2, _
swSelData As SldWorks.SelectData _
)
Dim vEdgeArr As Variant
Dim vEdge As Variant
Dim swEdge As SldWorks.Edge
Dim swEnt As SldWorks.entity
Dim bRet As Boolean
vEdgeArr = swLoop.GetEdges
Debug.Assert Not IsEmpty(vEdgeArr)
For Each vEdge In vEdgeArr
Set swEdge = vEdge
Set swEnt = swEdge
bRet = swEnt.Select4(True, swSelData): Debug.Assert bRet
Next
End Sub
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swSelMgr As SldWorks.SelectionMgr
Dim swEdge As SldWorks.Edge
Dim swFace As SldWorks.face2
Dim swSelData As SldWorks.SelectData
Dim vCoEdgeArr As Variant
Dim vCoEdge As Variant
Dim swCoEdge As SldWorks.CoEdge
Dim swLoop As SldWorks.Loop2
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swSelMgr = swModel.SelectionManager
Set swEdge = swSelMgr.GetSelectedObject5(1)
Set swSelData = swSelMgr.CreateSelectData
Set swFace = swSelMgr.GetSelectedObject5(2)
swModel.ClearSelection2 True
vCoEdgeArr = swEdge.GetCoEdges
Debug.Assert Not IsEmpty(vCoEdgeArr)
' 1 or 2 coedges for an edge on a surface body
' 2 coedges for an edge on a solid body
Debug.Assert UBound(vCoEdgeArr) >= 0
If 0 = UBound(vCoEdgeArr) Then
Set swCoEdge = vCoEdgeArr(0)
' no ambiguity, so select
Set swLoop = swCoEdge.GetLoop
SelectLoop (swApp, swModel, swLoop, swSelData)
Exit Sub
End If
' 2 coedges, so must have face to resolve ambiguity
Debug.Assert Not swFace Is Nothing
For Each vCoEdge In vCoEdgeArr
Set swCoEdge = vCoEdge
If swEdge Is swCoEdge.GetEdge Then
Set swLoop = swCoEdge.GetLoop
If swFace Is swLoop.GetFace Then
SelectLoop (swApp, swModel, swLoop, swSelData)
End If
End If
Next
End Sub
'--------------------------------------------
Select Loop ist der Aufruf der Funktion Select Loop!
Das Beispiel läuft nicht, du musst noch die Variablen die in Select Loop übergeben werden sollen in der Funktion einbringen, die Zeilenumbrüche führen im Beispiel zu Fehlern!
Also folgendes anstelle der vielen Zeilenumbrüche verwenden!
Select loop(swApp, swModel, swLoop, swSelData)
Wie gesagt, geh über den Loop und schau alle Kanten durch, prüfe dann jede Kante und schau ob sie mit deiner Auswahl zu tun hat!
Hoffe konnte dir etwas Helfen!
Gruß Sebastian
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP