Rob Edwards

Delete Sketch Entities Smaller Than...  Macro

Discussion created by Rob Edwards on Jan 9, 2019
Latest reply on Jan 9, 2019 by Jerome De San Nicolás

It ain't pretty but gets the job done

 

' SOLIDWORKS 2016
' This macro will remove sketch entities smaller than a specified length (mm)
' Run the macro whilst editing a sketch OR
' You can select multiple sketches and it will ask for a dimension for each one
' By the way if you remove all the sketch entities SW will delete the sketch
' Warning - I'm a joiner not a programmer, so use at your own risk!
' https://forum.solidworks.com/people/1-2SZI4TC

Option Explicit

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swSelMgr As SldWorks.SelectionMgr
Dim swFeature As SldWorks.Feature
Dim bs As Boolean

Sub main()

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc

    If Not swModel Is Nothing Then

        If Not swModel.SketchManager.ActiveSketch Is Nothing Then

            Call ProcessActiveSketch

        Else 'check selections

             Set swSelMgr = swModel.SelectionManager
            With swSelMgr
                Dim sketchFeatureCollection As New Collection

                Dim i As Integer
                For i = 1 To .GetSelectedObjectCount2(Mark:=-1)
                    If .GetSelectedObjectType3(index:=i, Mark:=-1) = swSelectType_e.swSelSKETCHES Then

                        Set swFeature = .GetSelectedObject6(index:=i, Mark:=-1)
                        Call sketchFeatureCollection.Add(Item:=swFeature)

                    End If
                Next

                Select Case True
                       Case sketchFeatureCollection Is Nothing, sketchFeatureCollection.Count = 0
                                Call swApp.SendMsgToUser2("No Active Sketch or Sketches Selected", swMbStop, swMbOk)
                                Exit Sub
                End Select
            End With 'swSelMgr

            For i = 1 To sketchFeatureCollection.Count

                Set swFeature = sketchFeatureCollection(i)
                bs = swFeature.Select2(Append:=False, Mark:=-1)

                swModel.EditSketch
                Call ProcessActiveSketch

            Next i

        End If
    End If
End Sub


Private Sub ProcessActiveSketch()

    Dim swSketchSegment As SldWorks.SketchSegment
    Dim smallSegmentCount As Integer
    Dim vSegments As Variant
    Dim minLength As Double
    Dim exitLoop As Boolean

    exitLoop = False
    Do Until exitLoop

        With swModel.SketchManager.ActiveSketch

            vSegments = .GetSketchSegments
            swModel.ClearSelection2 True

            Dim userInput As Variant

            userInput = InputBox("Minimum Length(mm)", .Name)
            If userInput = "" Then
                exitLoop = True
            Else
                minLength = CDbl(userInput) / 1000
                smallSegmentCount = 0

                Dim j As Integer
                For j = LBound(vSegments) To UBound(vSegments)

                    Set swSketchSegment = vSegments(j)
                    If swSketchSegment.GetLength < minLength Then
                        smallSegmentCount = smallSegmentCount + 1
                        bs = swSketchSegment.Select4(True, Nothing)
                    End If
                Next j

                Select Case swApp.SendMsgToUser2(smallSegmentCount & " entit" & _
                                                IIf(smallSegmentCount = 1, "y", "ies") & " less than " & minLength * 1000 & "mm selected in " & .Name & vbCr _
                                                & "Delete? - Yes" & vbCr & "Change threshold - No" _
                                                , swMbQuestion, swMbYesNoCancel)

                       Case swMbHitYes: swModel.EditDelete: exitLoop = True
                       Case swMbHitCancel: exitLoop = True
                      'Case swMbHitNo: exitLoop = False
                End Select

            End If
        End With 'ActiveSketch

    Loop

    swModel.SketchManager.InsertSketch True

End Sub

Outcomes