Gleiche Kanten finden

Option Explicit
Const DECIMAL_PLACES As Long = 8

Sub main()
    Dim swApp As SldWorks.SldWorks: Set swApp = Application.SldWorks
    Dim swModel As ModelDoc2: Set swModel = swApp.ActiveDoc
    If swModel Is Nothing Then Exit Sub
    Dim swSelMgr As SelectionMgr: Set swSelMgr = swModel.SelectionManager
    If swSelMgr.GetSelectedObjectCount2(-1) <> 1 Then Exit Sub
    If swSelMgr.GetSelectedObjectType3(1, -1) = swSelectType_e.swSelFACES Then HandleFaces swSelMgr
    If swSelMgr.GetSelectedObjectType3(1, -1) = swSelectType_e.swSelEDGES Then HandleEdges swSelMgr
End Sub

Private Sub HandleFaces(ByRef selMgr As SelectionMgr)
    Dim swFace As Face2: Set swFace = selMgr.GetSelectedObject6(1, -1)
    Dim swSurface As Surface: Set swSurface = swFace.GetSurface
    If swSurface.IsPlane = False Then Exit Sub
    Dim faceNormal As Variant: faceNormal = swFace.Normal
    Dim swBody As Body2: Set swBody = swFace.GetBody
    Dim bodyFaces As Variant: bodyFaces = swBody.GetFaces
    Dim vFace As Variant
    For Each vFace In bodyFaces
        Dim tFace As Face2: Set tFace = vFace
        Dim tFaceNormal As Variant: tFaceNormal = tFace.Normal
        If _
		  Round(Abs(tFaceNormal(0)), DECIMAL_PLACES) = Round(Abs(faceNormal(0)), DECIMAL_PLACES) And _
          Round(Abs(tFaceNormal(1)), DECIMAL_PLACES) = Round(Abs(faceNormal(1)), DECIMAL_PLACES) And _
          Round(Abs(tFaceNormal(2)), DECIMAL_PLACES) = Round(Abs(faceNormal(2)), DECIMAL_PLACES) Then
            Dim swEntity As Entity: Set swEntity = tFace
            swEntity.Select4 True, Nothing
        End If
    Next
End Sub

Private Sub HandleEdges(ByRef selMgr As SelectionMgr)
    Dim swEdge As Edge: Set swEdge = selMgr.GetSelectedObject6(1, -1)
    Dim swCurve As Curve: Set swCurve = swEdge.GetCurve
    If swCurve.IsLine = False Then Exit Sub
    Dim vLineParam As Variant: vLineParam = swCurve.LineParams
    Dim swBody As Body2: Set swBody = swEdge.GetBody
    Dim bodyEdges As Variant: bodyEdges = swBody.GetEdges
    Dim vEdge As Variant
    For Each vEdge In bodyEdges
        Dim tEdge As Edge: Set tEdge = vEdge
        Dim tEdgeCurve As Curve: Set tEdgeCurve = tEdge.GetCurve
        Dim tLineParam As Variant: tLineParam = tEdgeCurve.LineParams
        If _
          Round(Abs(tLineParam(3)), DECIMAL_PLACES) = Round(Abs(vLineParam(3)), DECIMAL_PLACES) And _
          Round(Abs(tLineParam(4)), DECIMAL_PLACES) = Round(Abs(vLineParam(4)), DECIMAL_PLACES) And _
          Round(Abs(tLineParam(5)), DECIMAL_PLACES) = Round(Abs(vLineParam(5)), DECIMAL_PLACES) Then
            Dim swEntity As Entity: Set swEntity = tEdge
            swEntity.Select4 True, Nothing
        End If
    Next
End Sub