Inventor中工作点导出到excel

一位顾客在零件中创建了许多工作点，然后客户需要一个Excel文件，包含这些工作点的坐标。下面的一个VBA宏，将创建一个CSV文件，其中包含了零件中工作点的坐标。如果您在运行宏之前选择了一部分工作点，那么这个宏将出现一个选项，提示您只会输出已经选定的工作点或输出所有的工作点。如果没有选定的工作点，那么它会导出所有的工作点。

 

这个宏开始并没有考虑到单位问题，因为Inventor的默认单位是CM，而不是MM，所以输出的尺寸是不正确的，下面是更新。

 

更新：自从我第一次发布这篇文章，我收到了有关宏程序如何使用的文件的当前单位的问题。我已经修改了下面的代码。在此之前，它是使用内部厘米的长度单位。它现在使用的文件中指定的长度，但它忽略了文件中指定的小数点后数字的数量，总是写入多达8位小数。

 

程序如下:

 

Public Sub ExportWorkPoints()
   ' Get the active part document.
    Dim partDocAs PartDocument
    IfThisApplication.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 areselected.
    Dim points()As WorkPoint
    DimpointCount As Long
    pointCount =0
    IfpartDoc.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 allpoints.
    DimgetAllPoints As Boolean
    getAllPoints= True
    IfpointCount > 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 workpoints" & _
                 " will be exported.  Do you want to continue?",_
                 vbQuestion + vbYesNo) = vbNo Then
           Exit Sub
       End If
    End If
   
    Dim partDefAs PartComponentDefinition
    Set partDef= partDoc.ComponentDefinition
    IfgetAllPoints 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 dialogAs FileDialog
    Dim filenameAs String
    CallThisApplication.CreateFileDialog(dialog)
    Withdialog
       .DialogTitle = "Specify Output .CSV File"
       .Filter = "Comma delimited file (*.csv)|*.csv"
       .FilterIndex = 0
       .OptionsEnabled = False
       .MultiSelectEnabled = False
       .ShowSave
       filename = .filename
    EndWith
   
    If filename<> "" Then
       ' Write the work point coordinates out to a csvfile.
       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 unitconversions.
       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/my_weblog/2011/06/writing-work-points-to-an-excel-file.html?utm_source=feedburner&utm_medium=feed&utm_campaign=Feed:+modthemachine+(Mod+the+Machine)