- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
I am trying to write a macro that will automatically export my selected work points to an excel sheet. So far I've been able to get it to do everything I need it to except I need the coordinates based off my UCS, not the origin. Its just like how when you use the Measure Tool you can select either your part origin or one of your UCS's. Does anyone know how to help with this?
I don't have alot of experience with programming, most of my attached code is a Frankenstein of various other codes I've seen online. Like I said, all I need to do is get it to export point coordinates based off my UCS. For the ease of programming, lets assume that the UCS I want to use will always be the newest UCS. I appreciate any help I can get!
Solved! Go to Solution.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
you can get workpoint coordinates acc. to UCS like this.
Dim doc As PartDocument = ThisDoc.Document Dim partDef As PartComponentDefinition = doc.ComponentDefinition Dim workpoint As WorkPoint = partDef.WorkPoints.Item(1) Dim point As Point = workpoint.Point MsgBox(String.Format("WorkPoint: {0}x{1}x{2}", point.X, point.Y, point.Z)) Dim yourUCS As UserCoordinateSystem = partDef.UserCoordinateSystems.Item(1) Dim yourUCSmat As Matrix = yourUCS.Transformation point.TransformBy(yourUCSmat) MsgBox(String.Format("WorkPoint acc. to UCS: {0}x{1}x{2} (Dimensions in cm)", point.X, point.Y, point.Z))
Jelte de Jong
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
Blog: hjalte.nl - github.com
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
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
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
points(i).Point is read only there for it cant be transformed. try to create a new point and transform that point. something like this:
For i = 0 To UBound(points)
dim newPoint as Point
newPoint = points(i).Point
newPoint.TransformBy(yourUCSmat)
Dim xCoord As Double
xCoord = uom.ConvertUnits(newPoint.X, _
kCentimeterLengthUnits, kDefaultDisplayLengthUnits)
Jelte de Jong
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
Blog: hjalte.nl - github.com
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
That kind of worked. It offset my coordinates in the wrong direction though. After I defined my matrix I inverted it and that solved my issue. Thanks for helping!
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hi, I'm actually in the same position here. According to my tests, Point.TransformBy(UCS) will only do the translation part of the matrix. If your UCS is rotated, that seems a problem.
I found no convient way so far, seems I have to go the full matrix calculation way.