如何在Inventor中将工作点输出到Excel文件中

rumor

　　本文翻译自Mod the Machine, 有删改，具体链接见页尾。
　　一位顾客在零件中创建了许多工作点，然后客户需要一个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
　　http://modthemachine.typepad.com ... =feedburner&amp;utm_medium=feed&utm_campaign=Feed:+modthemachine+(Mod+the+Machine)