×
INTELLIGENT WORK FORUMS
FOR ENGINEERING PROFESSIONALS

Log In

Come Join Us!

Are you an
Engineering professional?
Join Eng-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Eng-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Jobs

Extracting XYZ Point Data from SW

Extracting XYZ Point Data from SW

Extracting XYZ Point Data from SW

(OP)
thread559-160366: How to create a table of X,YZ Points for Inpection?


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

RE: Extracting XYZ Point Data from SW

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)

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Eng-Tips Forums free from inappropriate posts.
The Eng-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Eng-Tips forums is a member-only feature.

Click Here to join Eng-Tips and talk with other members!


Resources