0 Replies Latest reply on Oct 3, 2014 4:33 AM by Manu Rao

    How to loop through all arcs in a sketch segment?

    Manu Rao

      I'm trying to create a macro that will place points at the turning points of a chain of pipes and U bends.

      The macro should use the sketch driving the pipe model to create a new sketch containing points that are coincident with the midpoint of the U bends.

      So far I've run into two problems.


      1. Not all the arc segments are selected when I loop through them.

          On some sketches a few of the first arcs are selected, on others the last few arcs and on others a few middle arcs.


      2. -When I place the points outside of the sketch (horizontal along the sketch plane), the points snap to the middle of the arc  with the SketchAddConstraints "sgATMIDDLE" command. I Want This!

           -When I place the points inside the sketch, the points snap of the radial centre of the arc. I DO NOT Want This!


      Please help


      Here is my code


      Dim swApp As Object
      Dim Part As Object
      Dim boolstatus As Boolean
      Dim longstatus As Long, longwarnings As Long
      Dim newSketch As Sketch
      Dim newFeat As Feature
      Dim instance As ISketch
      Dim partFeat As Feature
      Dim partSketch As Sketch
      Dim NumArcs As Long
      Dim strArcName As String
      Dim i As Variant
      Dim myModelView As Object
      Dim skPoint As Object
      Dim measure As measure
      Dim radius As Double



      Sub main()

      Set swApp = Application.SldWorks
      Set Part = swApp.ActiveDoc

      'End Macro if no active document open


      If Part Is Nothing Then
      Exit Sub
      End If


      Set myModelView = Part.ActiveView
      myModelView.FrameState = swWindowState_e.swWindowMaximized


      'Selects and sets the coil to be analysed

      boolstatus = Part.Extension.SelectByID2("COIL 3D SKETCH", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)
      Set partFeat = Part.SelectionManager.GetSelectedObject5(1)

      If partFeat Is Nothing Then
      Set partSketch = Part.GetActiveSketch2

      If partSketch Is Nothing Then
      MsgBox ("You must select the sketch or rename the desired sketch to 'COIL 3D SKETCH'")
      Exit Sub
      End If

      Set partSketch = partFeat.GetSpecificFeature2
      End If


      'Calculates the number of arcs within sketch and displays sketch information

      NumArcs = partSketch.GetArcCount
      Debug.Print "Feature = " & partFeat.GetTypeName
      Debug.Print "Name = " & partFeat.Name
      Debug.Print "  NumArcs = " & NumArcs
      Part.ClearSelection2 True


      'Creates a new Sketch called Coil Endpoints in which to place arc segment midpoints

      Part.SketchManager.Insert3DSketch False
      Set newSketch = Part.SketchManager.ActiveSketch
      Set newFeat = newSketch
      newFeat.Name = "Coil Endpoints"
      Part.SketchManager.Insert3DSketch False
      Part.ClearSelection2 True


      'Loops through arc segments and places points at middle of 180 degree arcs


      'Measures arc

      For i = 0 To NumArcs
      strArcName = "Arc" & i & "@" & partFeat.Name
      Debug.Print "Arc Name: " & strArcName
      Part.ClearSelection2 True
      boolstatus = Part.Extension.SelectByID2(strArcName, "EXTSKETCHSEGMENT", 0, 0, 0, True, 0, Nothing, 0)

      Debug.Print "Arc selected?" & boolstatus
      Set measure = Part.Extension.CreateMeasure
      boolstatus = measure.Calculate(Nothing)

      If (boolstatus) Then

      If (Not (measure.ArcLength = -1)) Then
              Debug.Print "Arc length: " & measure.ArcLength
      End If


      If (Not (measure.radius = -1)) Then
              Debug.Print "Radius: " & measure.radius
      End If

      If (Not (measure.Angle = -1)) Then
              Debug.Print "Angle: " & measure.Angle
      End If



          Debug.Print "Can Measure? " & boolstatus
      End If


      'Creates point if arc is 180 degrees

      If measure.Angle = 3.14159265 Then
      Part.ClearSelection2 True
      boolstatus = Part.Extension.SelectByID2("Coil Endpoints", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)
      Part.ClearSelection2 True
      Set skPoint = Part.SketchManager.CreatePoint(0, 1000, -0#)


      'Places point at midpoint of selected arc

      boolstatus = Part.Extension.SelectByID2(strArcName, "EXTSKETCHSEGMENT", 0, 0, 0, True, 0, Nothing, 0)
      boolstatus = Part.Extension.SelectByID2("", "SKETCHPOINT", 0, 1000, -0#, True, 0, Nothing, 0)
      Part.SketchAddConstraints "sgATMIDDLE"
      Part.ClearSelection2 True
      End If

      Next i

      Part.SketchManager.Insert3DSketch False


      End Sub