CAD Forum

Code: Select all

Sub main()
    Dim swApp As SldWorks.SldWorks
    Dim swDoc As SldWorks.ModelDoc2
    Dim swRelMgr As SldWorks.SketchRelationManager
    Dim swSketch As SldWorks.Sketch
    Dim vRels As Variant
    Dim swRel As SldWorks.SketchRelation
    Dim i As Long
    
    Set swApp = Application.SldWorks
    Set swDoc = swApp.ActiveDoc
    Set swSkMgr = swDoc.SketchManager
    Set swSketch = swDoc.GetActiveSketch2
    If swSketch Is Nothing Then
        If swDoc.SelectionManager.GetSelectedObjectType3(1, -1) = swSelSKETCHES Then
            Set swSketch = swDoc.SelectionManager.GetSelectedObject6(1, -1).GetSpecificFeature
        Else
            MsgBox "No active or selected sketch"
            Exit Sub
        End If
    End If
    Set swRelMgr = swSketch.RelationManager
    If swRelMgr.GetRelationsCount(swDangling) > 0 Then
        vRels = swRelMgr.GetRelations(swDangling)
        For i = 0 To UBound(vRels)
            Set swRel = vRels(i)
            swRelMgr.DeleteRelation swRel
        Next i
        MsgBox UBound(vRels) + 1 & " dangling relations deleted from " & swSketch.Name
    Else
        MsgBox "No dangling relations were found in " & swSketch.Name
    End If
End Sub