Extracting XYZ Point Data from SW

[lukasf19]

thread559-160366


Hello the user "Handleman" suggest the following macro to export xyz coordinates of points in a 3-D sketch into an excel sheet. His post is 9 years old. What would I have to adjust to make this script work today? I use Solidworks 14 x64, Excel 2013 and Windows 8.1. (german). I used this code to create a macro and run it. It did not work. After deleting all the commands above "Sub main()", the script opens at least an excel sheet. I would appreciate any help.

Dim swApp As SldWorks.SldWorks
Dim Part As SldWorks.ModelDoc2
Dim boolstatus As Boolean
Dim longstatus As Long
Dim Annotation As Object
Dim Gtol As Object
Dim DatumTag As Object
Dim FeatureData As Object
Dim Feature As Object
Dim Component As Object
Public Pfx As String
Dim myNote As SldWorks.Note
Dim SelMgr As SldWorks.SelectionMgr
Dim mySketchPoint As SldWorks.SketchPoint
Dim mySketch As SldWorks.Sketch
Dim AllSketchPoints As Variant
Const FMAT As String = "0.00"
Const SF As Double = 1000
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Const FirstRow As Long = 4
Const FirstCol As Long = 2
Dim CurRow As Long
Dim IDCol As Long
Dim Xcol As Long
Dim Ycol As Long
Dim Zcol As Long
Dim PtID As Variant
Dim i As Long

Sub main()

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

If (SelMgr.GetSelectedObjectType3(1, -1) <> 11) And (SelMgr.GetSelectedObjectType3(1, -1) <> 25) Then
MsgBox "Select a sketch point of a 3D sketch and run macro again"
Exit Sub
End If

Set mySketchPoint = SelMgr.GetSelectedObject6(1, -1)
Set mySketch = mySketchPoint.GetSketch
AllSketchPoints = mySketch.GetSketchPoints2

Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets("Sheet1")

CurRow = FirstRow
IDCol = FirstCol
Xcol = FirstCol + 1
Ycol = FirstCol + 2
Zcol = FirstCol + 3
xlSheet.Cells(CurRow, IDCol).Value = "'Point ID"
xlSheet.Cells(CurRow, Xcol).Value = "'X Coord"
xlSheet.Cells(CurRow, Ycol).Value = "'Y Coord"
xlSheet.Cells(CurRow, Zcol).Value = "'Z Coord"
CurRow = CurRow + 1

For i = 0 To UBound(AllSketchPoints)
PtID = AllSketchPoints(i).GetID
xlSheet.Cells(CurRow, IDCol).Value = PtID(0) & "," & PtID(1)
xlSheet.Cells(CurRow, Xcol).Value = Format(AllSketchPoints(i).X * SF, FMAT)
xlSheet.Cells(CurRow, Ycol).Value = Format(AllSketchPoints(i).Y * SF, FMAT)
xlSheet.Cells(CurRow, Zcol).Value = Format(AllSketchPoints(i).Z * SF, FMAT)
CurRow = CurRow + 1
Next i


Part.ClearSelection
Part.WindowRedraw

End Sub

 

[handleman]

Inside VBA editor, go to Tools->References. Find "Microsoft Excel xx.x Object Library" in the list. Check the box.

-handleman, CSWP (The new, easy test)