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
SolidworksApi/macros