caution this program reads the points in order of creation so you may need to rearrange your data in excel if they are out of order!
instructions:
select the sketch that you wish to "read" and run the macro.
the macro will bring up excel and start filling the sheet with xyz point data.
Source Code:
-----------------------------------------------------------
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 v As Variant
Dim i As Long
Dim sseg As SldWorks.SketchSegment
Dim sline As SldWorks.SketchLine
Dim sp As SldWorks.SketchPoint
Dim ep As SldWorks.SketchPoint
Dim s As String
Dim exApp As Excel.Application
Dim sheet As Excel.Worksheet
Set exApp = New 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 = "Y"
sheet.Cells(1, 4).Value = "Z"
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
v = sketch.GetSketchPoints
For i = LBound(v) To UBound(v)
Set sp = v(i)
If Not sp Is Nothing And Not sheet Is Nothing And Not exApp Is Nothing Then
'sheet.Cells(2 + i, 1).Value = "Normal Vector " & i + 1
sheet.Cells(2 + i, 2).Value = Round(sp.x * 1000 / 25.4, DEC)
sheet.Cells(2 + i, 3).Value = Round(sp.y * 1000 / 25.4, DEC)
sheet.Cells(2 + i, 4).Value = Round(sp.z * 1000 / 25.4, DEC)
exApp.Columns.AutoFit
End If
Next i
End If
End If
End If
End If
End If
End If
End Sub
