AnsweredAssumed Answered

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

Question asked by Adam Chapman on Sep 12, 2018

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

Outcomes