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