Macro to select equal arcs in the sketch using SOLIDWORKS API

Edit ArticleEdit Article
More 'Goodies'

Equal arcs selected in the sketch
Equal arcs selected in the sketch

This VBA macro selects equal size sketch arcs to the pre-selected input sketch arc. Only arcs in the sketch of the original input arc are selected. Macro works both for active and inactive sketch.


Macro can be configured by changing the values of the constant at the beginning of the macro

Const EPS As Double = 0.0000000001 'arcs radius comparison tolerance

Const EPS As Double = 0.0000000001

Dim swApp As SldWorks.SldWorks

Sub main()

    Set swApp = Application.SldWorks
    On Error GoTo catch
    Dim swModel As SldWorks.ModelDoc2
    Set swModel = swApp.ActiveDoc
    If Not swModel Is Nothing Then
        Dim swSkSrcArc As SldWorks.SketchArc
        Set swSkSrcArc = swModel.SelectionManager.GetSelectedObject6(1, -1)
        If Not swSkSrcArc Is Nothing Then
            Dim radius As Double
            radius = swSkSrcArc.GetRadius()
            Dim swSketch As SldWorks.Sketch
            Set swSketch = swSkSrcArc.GetSketch
            Dim vSegs As Variant
            vSegs = swSketch.GetSketchSegments()
            Dim i As Integer
            For i = 0 To UBound(vSegs)
                Dim swSkSeg As SldWorks.SketchSegment
                Set swSkSeg = vSegs(i)
                If swSkSeg.GetType() = swSketchSegments_e.swSketchARC Then
                    If Not swSkSrcArc Is swSkSeg Then
                        Dim swSkArc As SldWorks.SketchArc
                        Set swSkArc = swSkSeg
                        If Abs(swSkArc.GetRadius() - radius) < EPS Then
                            swSkSeg.Select4 True, Nothing
                        End If
                    End If
                End If
            Err.Raise vbError, "", "Please select sketch arc"
        End If
        Err.Raise vbError, "", "Open model"
    End If
    GoTo finally
    swApp.SendMsgToUser2 Err.Description, swMessageBoxIcon_e.swMbStop, swMessageBoxBtn_e.swMbOk
End Sub

Product of Xarial Product of Xarial