Exporting x,y,z corrdinates

Cody,

Attached is a macro that I've been using for a while that exports 3Dsketch point to an excel file. Just select the 3Dsketch in your feature tree, run the macro and then format your table anyway you would like. The only thing I have run into with this macro is if any of the points have coincident relationships to other points, you will get double coordinates in your table. Hope that works for you!

done it

Option Explicit

Dim Feature As SldWorks.Feature
Dim swApp As SldWorks.SldWorks
Dim swModel As ModelDoc2
Dim swFeat As SldWorks.Feature
Dim swSubFeat As SldWorks.Feature
Dim profileFeature As Sketch
Dim sketchpoints As Variant
Dim sketchPoint As SldWorks.sketchPoint
Dim i As Integer
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Const FirstRow As Long = 4
Const namerow As Long = 3
Dim FirstCol As Long
Dim CurRow As Long
Dim IDCol As Long
Dim Xcol As Long
Dim Ycol As Long
Dim Zcol As Long
Dim v As Long

'To run this macro open the model and run macro
'You have been warned this with travese through allsketches

Sub main()

'open and format the excel sheet
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets("Sheet1")

CurRow = FirstRow
FirstCol = 2
IDCol = FirstCol
Xcol = FirstCol + 1
Ycol = FirstCol + 2
Zcol = FirstCol + 3
xlSheet.Cells(2, IDCol).Value = "All values are in mm"
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

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swFeat = swModel.FirstFeature

Do While Not swFeat Is Nothing
 
  Set swSubFeat = swFeat.GetFirstSubFeature
 
  ' Process feature
  DoFeature swFeat
 
  Do While Not swSubFeat Is Nothing

    ' Process feature
    DoFeature swSubFeat
   
    Set swSubFeat = swSubFeat.GetNextSubFeature

  Loop
  Set swFeat = swFeat.GetNextFeature
 
Loop

End Sub

Private Sub DoFeature(feat As Feature)
   
    If feat.GetTypeName2 = "3DProfileFeature" Then
        ' Do the business on the feature
        Set profileFeature = feat.GetSpecificFeature2()
       
     
    
     If CurRow > 5 Then
     CurRow = FirstRow
FirstCol = FirstCol + 5
IDCol = FirstCol
Xcol = FirstCol + 1
Ycol = FirstCol + 2
Zcol = FirstCol + 3
xlSheet.Cells(2, IDCol).Value = "All values are in mm"
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"
  ' Get the name
xlSheet.Cells(namerow, IDCol).Value = "Sketch Name: " & feat.Name
CurRow = CurRow + 1
v = 0
Else
   ' Get the namae
xlSheet.Cells((namerow), IDCol).Value = "Sketch Name: " & feat.Name
End If

       
        ' Get the sketch segments
        sketchpoints = profileFeature.GetSketchPoints2
       

        ' Loop all segments
        For i = 0 To UBound(sketchpoints)
           
        Set sketchPoint = sketchpoints(i)
       'Export points in mm to Excel
            xlSheet.Cells(CurRow, IDCol).Value = ".Pt" & v + 1
            xlSheet.Cells(CurRow, Xcol).Value = Format(sketchPoint.X * 1000)
            xlSheet.Cells(CurRow, Ycol).Value = Format(sketchPoint.Y * 1000)
            xlSheet.Cells(CurRow, Zcol).Value = Format(sketchPoint.Z * 1000)
            CurRow = CurRow + 1
v = v + 1
        Next
       
    End If

End Sub

Needs the code cleaning up a bit and some dialog boxes putting in. only works for 3d sketched not sure how to do it for 2d sketches as well which be xz or zy or xy?

can you help?