一位顧客在零件中創建了許多工作點，然后客戶需要一個Excel文件，包含這些工作點的坐標。下面的一個VBA宏，將創建一個CSV文件，其中包含了零件中工作點的坐標。如果您在運行宏之前選擇了一部分工作點，那么這個宏將出現一個選項，提示您只會輸出已經選定的工作點或輸出所有的工作點。如果沒有選定的工作點，那么它會導出所有的工作點。

這個宏開始并沒有考慮到單位問題，因為Inventor的默認單位是CM，而不是MM，所以輸出的尺寸是不正確的，下面是更新。

更新：自從我第一次發布這篇文章，我收到了有關宏程序如何使用的文件的當前單位的問題。我已經修改了下面的代碼。在此之前，它是使用內部厘米的長度單位。它現在使用的文件中指定的長度，但它忽略了文件中指定的小數點后數字的數量，總是寫入多達8位小數。

程序如下:

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