I tried adding a line with points(i).TransformBy(yourUCSmat) but I would get errors. I looked at other examples of people using transforms and they use Call. So I tried that, I now have a line of Call points(i).Point.TransformBy(yourUCSmat) and I no longer get an error. But it doesn't seem to be applying any changes to my points. What am I doing wrong?
Public Sub ExportWorkPoints()
Dim partDoc As PartDocument
Dim partCompDef As PartComponentDefinition
If ThisApplication.ActiveDocumentType = kPartDocumentObject Then
Set partDoc = ThisApplication.ActiveDocument
Dim partDef As PartComponentDefinition
Set partDef = partDoc.ComponentDefinition
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
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 yourUCS As UserCoordinateSystem
Set yourUCS = partDef.UserCoordinateSystems.Item(1)
Dim yourUCSmat As Matrix
Set yourUCSmat = yourUCS.Transformation
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
Print #1, "Point" & "," & _
"X:" & "," & _
"Y:" & "," & _
"Z:" & "," & _
"Radius:" & "," & _
"Work point name"
For i = 0 To UBound(points)
Call points(i).Point.TransformBy(yourUCSmat)
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 + 1 & "," & _
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