Public Sub ExportWorkPoints() Dim partDoc As PartDocument Dim partCompDef As PartComponentDefinition If ThisApplication.ActiveDocumentType = kPartDocumentObject Then Set partDoc = ThisApplication.ActiveDocument Else MsgBox "A part must be active." Exit Sub End If Dim points() As WorkPoint Dim pointCount As Long pointCount = 0 If partDoc.SelectSet.Count > 0 Then 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 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)", 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) Dim i As Integer For i = 2 To partDef.WorkPoints.Count Set points(i - 2) = partDef.WorkPoints.Item(i) Next End If 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 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 Dim uom As UnitsOfMeasure Set uom = partDoc.UnitsOfMeasure Dim yourUCSmat As Matrix Set yourUCSmat = yourUCS.Transformation Print #1, "Point" & "," & _ "X:" & "," & _ "Y:" & "," & _ "Z:" & "," & _ "Radius:" & "," & _ "Work point name" For i = 0 To UBound(points) Dim xCoord As Double xCoord = uom.ConvertUnits(points(i).Point.X, _ kCentimeterLengthUnits, kDefaultDisplayLengthUnits) Dim yCoord As Double yCoord = uom.ConvertUnits(points(i).Point.Y, _ kCentimeterLengthUnits, kDefaultDisplayLengthUnits) Dim zCoord As Double zCoord = uom.ConvertUnits(points(i).Point.Z, _ kCentimeterLengthUnits, kDefaultDisplayLengthUnits) Print #1, i & "," & _ Format(xCoord, "0.000") & "," & _ Format(yCoord, "0.000") & "," & _ Format(zCoord, "0.000") & "," & _ "," & _ points(i).Name Next Close #1 MsgBox "Finished writing data to """ & filename & """" End If End Sub