0 Replies Latest reply on Sep 13, 2018 7:07 AM by Adam Chapman

    How to pull a radius of a 2D sketch and put this in to an excel document relating to the center point of rad?

    Adam Chapman

      I have a macro to pull points of a 2D sketch. But its pulling through center points for the radius. I am wanting the macro to either remove the center points of the radius or pull through the radius relating to the center point. The reason i am doing this is to get X and Z to make it easier programming a CNC Lathe. Any help would be appreciated.

       

      Macro Shown Below

       

      Dim swApp As Object

      Sub main()

      Dim swApp As SldWorks.SldWorks

      Dim doc As SldWorks.ModelDoc2

      Dim part As SldWorks.PartDoc

      Dim sm As SldWorks.SelectionMgr

      Dim feat As SldWorks.Feature

      Dim sketch As SldWorks.sketch

      Dim vp As Variant

      Dim ip As Long

      Dim sseg As SldWorks.SketchSegment

      Dim sline As SldWorks.SketchLine

      Dim sp As SldWorks.SketchPoint

      Dim s As String

       

       

      Dim exApp As Object

      Dim sheet As Object

       

       

      Set exApp = CreateObject("Excel.Application")

      If Not exApp Is Nothing Then

        exApp.Visible = True

        If Not exApp Is Nothing Then

         exApp.Workbooks.Add

         Set sheet = exApp.ActiveSheet

         If Not sheet Is Nothing Then

          sheet.Cells(1, 2).Value = "X"

          sheet.Cells(1, 3).Value = "Z"

          sheet.Cells(1, 4).Value = "R"

         End If

        End If

      End If

       

      Set swApp = GetObject(, "sldworks.application")

      If Not swApp Is Nothing Then

        Set doc = swApp.ActiveDoc

        If Not doc Is Nothing Then

         If doc.GetType = swDocPART Then

          Set part = doc

          Set sm = doc.SelectionManager

          If Not part Is Nothing And Not sm Is Nothing Then

           If sm.GetSelectedObjectType2(1) = swSelSKETCHES Then

            Set feat = sm.GetSelectedObject4(1)

            Set sketch = feat.GetSpecificFeature

            If Not sketch Is Nothing Then

             vp = sketch.GetSketchPoints

             For ip = LBound(vp) To UBound(vp)

              Set sp = vp(ip)

             

             

              If Not sp Is Nothing And Not sheet Is Nothing And Not exApp Is Nothing Then

               sheet.Cells(2 + ip, 2).Value = Round(sp.X * 1000, 3)

               sheet.Cells(2 + ip, 3).Value = Round(sp.Y * 1000, 3)

              

       

       

               exApp.Columns.AutoFit

              End If

             Next ip

            End If

           End If

          End If

         End If

        End If

      End If

      End Sub