Announcements
Attention for Customers without Multi-Factor Authentication or Single Sign-On - OTP Verification rolls out April 2025. Read all about it here.

Export coordinates in relation to UCS

Anonymous

Export coordinates in relation to UCS

Anonymous
Not applicable

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!

 

0 Likes
Reply
Accepted solutions (1)
1,249 Views
5 Replies
Replies (5)

JelteDeJong
Mentor
Mentor

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.

EESignature


Blog: hjalte.nl - github.com

0 Likes

Anonymous
Not applicable

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

 

0 Likes

JelteDeJong
Mentor
Mentor
Accepted solution

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.

EESignature


Blog: hjalte.nl - github.com

0 Likes

Anonymous
Not applicable

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!

0 Likes

gilsdorf_e
Collaborator
Collaborator

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.

0 Likes