Writing Work Points to an Excel File

Here’s a solution to another problem that was recently posed.  A customer is creating work points in a part and then needs an Excel file that has the coordinates of the work points.  Here’s a VBA macro that will create a .csv file that contains the coordinates of the work points.  If you select any work points before running the macro, it will give you the option of exporting only the selected work points or exporting all of the work points.  If no work points are selected, then it will export all work points.  Let me know if you find any issues or have suggestions on how to improve it.

Update: Since I first posted this I received a question about how to have the macro use the current length units of the document.  I’ve modified it so it now does that.  Previously it was using the internal length unit of centimeters.  It now uses the length specified for the document, but it ignores the number of decimal places specified for the document and always writes out up to 8 decimal places.

Public Sub ExportWorkPoints()
    ' Get the active part document.
    Dim partDoc As PartDocument
    If ThisApplication.ActiveDocumentType = kPartDocumentObject Then
        Set partDoc = ThisApplication.ActiveDocument
    Else
        MsgBox "A part must be active."
        Exit Sub
    End If
   
    ' Check to see if any work points are selected.
    Dim points() As WorkPoint
    Dim pointCount As Long
    pointCount = 0
    If partDoc.SelectSet.Count > 0 Then
        ' Dimension the array so it can contain the full
        ' list of selected items.
        ReDim points(partDoc.SelectSet.Count - 1)
       
        Dim selectedObj As Object
        For Each selectedObj In partDoc.SelectSet
            If TypeOf selectedObj Is WorkPoint Then
                Set points(pointCount) = selectedObj
                pointCount = pointCount + 1
            End If
        Next
       
        ReDim Preserve points(pointCount - 1)
    End If
   
    ' Ask to see if it should operate on the selected points
    ' or all points.
    Dim getAllPoints As Boolean
    getAllPoints = True
    If pointCount > 0 Then
        Dim result As VbMsgBoxResult
        result = MsgBox("Some work points are selected.  " & _
                "Do you want to export only the " & _
                "selected work points?  (Answering " & _
                """No"" will export all work points)", _
                vbQuestion + vbYesNoCancel)
        If result = vbCancel Then
            Exit Sub
        End If
   
        If result = vbYes Then
            getAllPoints = False
        End If
    Else
        If MsgBox("No work points are selected.  All work points" & _
                  " will be exported.  Do you want to continue?", _
                  vbQuestion + vbYesNo) = vbNo Then
            Exit Sub
        End If
    End If
   
    Dim partDef As PartComponentDefinition
    Set partDef = partDoc.ComponentDefinition
    If getAllPoints Then
        ReDim points(partDef.WorkPoints.Count - 2)
       
        ' Get all of the workpoints, skipping the first,
        ' which is the origin point.
        Dim i As Integer
        For i = 2 To partDef.WorkPoints.Count
            Set points(i - 2) = partDef.WorkPoints.Item(i)
        Next
    End If
   
    ' Get the filename to write to.
    Dim dialog As FileDialog
    Dim filename As String
    Call ThisApplication.CreateFileDialog(dialog)
    With dialog
        .DialogTitle = "Specify Output .CSV File"
        .Filter = "Comma delimited file (*.csv)|*.csv"
        .FilterIndex = 0
        .OptionsEnabled = False
        .MultiSelectEnabled = False
        .ShowSave
        filename = .filename
    End With
   
    If filename <> "" Then
        ' Write the work point coordinates out to a csv file.
        On Error Resume Next
        Open filename For Output As #1
        If Err.Number <> 0 Then
            MsgBox "Unable to open the specified file. " & _
                   "It may be open by another process."
            Exit Sub
        End If
       
        ' Get a reference to the object to do unit conversions.
        Dim uom As UnitsOfMeasure
        Set uom = partDoc.UnitsOfMeasure
       
        ' Write the points, taking into account the current default
        ' length units of the document.
        For i = 0 To UBound(points)
            Dim xCoord As Double
            xCoord = uom.ConvertUnits(points(i).Point.X, _ 
                 kCentimeterLengthUnits, kDefaultDisplayLengthUnits)
                    
            Dim yCoord As String
            yCoord = uom.ConvertUnits(points(i).Point.Y, _ 
                 kCentimeterLengthUnits, kDefaultDisplayLengthUnits)
                    
            Dim zCoord As String
            zCoord = uom.ConvertUnits(points(i).Point.Z, _ 
                 kCentimeterLengthUnits, kDefaultDisplayLengthUnits)
                    
            Print #1, points(i).Name & "," & _
                Format(xCoord, "0.00000000") & "," & _
                Format(yCoord, "0.00000000") & "," & _
                Format(zCoord, "0.00000000")
        Next
       
        Close #1
       
        MsgBox "Finished writing data to """ & filename & """"
    End If
End Sub

Comments

[Aksel]

Very good
How hability visible work point?
Last Creat Spline;
Att..

[Dan Margulius]

Hey,
I am looking for a macro wich can extract iproperties to excel. Do you have something like that?

Thanks

[Scott Moyse]

Brian,

Once again more great stuff. Unrelated to this topic but I'm hoping you would be kind enough to read through this thread http://forums.autodesk.com/t5/Autodesk-Inventor/Inventor-for-Woodworkers-Joinery-Millwork-and-Cabinetry-Design/td-p/3064850/highlight/false and maybe give some advice or offer an opinion? The length, Width, Thickness being automatically generated for irregular shaped or irregular orientated parts is the biggest issue for Inventor woodworkers and I'm sure a lot of Inventor users creating parts lists for ordering stock, or creating cut lists. Then there are a few other points in that thread that may be of interest to you.

Cheers for any help you may have the time to give

Scott