Advice/ help needed; macro code for selecting Absolute Axis system in Catia

[MecaTron101]

Hi!
I need som help with my macro code.
I'm working on a macro to create drawing tables with X, Y and Z coordinates for 3D points. So far I managed to get it working properly and it spits out nice tables, no problem there.
However, I want it to always extract coordinates relative to the absolute axis system. By default it picks the local axis, and that is fine as long as it's in the same position as the absolute, but if the local is moved the coordinates become inaccurate.
Below is a sample of my code. It uses a for loop to cycle the selected points and pick X, Y and Z. The code highlighted in green accesses Catia's measure function.
Is there a way select a specific axis system as point of origin? I've searched this forum but haven't been able to find anything that's been helpful to my problem.
If other users are interested in this type of macro I gladly post the whole code. I also have another macro that exports the same data to Excel.

Grateful for any help

[indent][/indent]'create the table itself
        Set MyTable = myView.Tables.Add(100, 100, numberOfPoints + 2, 4, 7.5, 20)
        
'**********************************************************************************************************************************************
    [highlight #8AE234]Set TheSPAWorkbench = CATIA.ActiveDocument.GetWorkbench("SPAWorkbench") ' set TheSPAWorkbench[/highlight]
    
    For i = 1 To numberOfPoints                 'create correct number of rows
        Set Element = selection1.Item(i)
            Set selPoint = Element.Value
        
        [highlight #8AE234]Set TheMeasurable = TheSPAWorkbench.GetMeasurable(selPoint)
            TheMeasurable.GetPoint coords       'get coordinates from Measurable[/highlight]                
            MyTable.SetCellString 2 + i, 1, letter & i  'add point index

                xPoint = Round(coords(0), 1) 'check if coordinate has decimals
                    If xPoint = 0 Then  'avoid division with zero
                        MyTable.SetCellString 2 + i, 2, "0,0"   'add 0,0
                    ElseIf Int(xPoint) / xPoint = 1 Then        'if integer
                        MyTable.SetCellString 2 + i, 2, xPoint & ",0"       'add ",0"
                    Else
                        MyTable.SetCellString 2 + i, 2, Round(coords(0), 1)     'else, use 1 decimal
                    End If
                
                yPoint = Round(coords(1), 1)        'same procedure for y and z
                    If yPoint = 0 Then
                        MyTable.SetCellString 2 + i, 3, "0,0"
                    ElseIf Int(yPoint) / yPoint = 1 Then
                        MyTable.SetCellString 2 + i, 3, yPoint & ",0"
                    Else
                        MyTable.SetCellString 2 + i, 3, Round(coords(1), 1)
                    End If

                zPoint = Round(coords(2), 1)
                    If zPoint = 0 Then
                        MyTable.SetCellString 2 + i, 4, "0,0"
                    ElseIf Int(zPoint) / zPoint = 1 Then
                        MyTable.SetCellString 2 + i, 4, zPoint & ",0"
                    Else
                        MyTable.SetCellString 2 + i, 4, Round(coords(2), 1)
                    End If
    Next

 

[itsmyjob]

faq560-1824

Check the first functions....

Eric N.
indocti discant et ament meminisse periti ​

 

[MecaTron101]

Hi again
Thanks for the tip.
I've been playing around with the code for getting coordinates from a specified axissystem, but I've run into a problem. Hope you can help me.
If you check the code under you link, the public function LCS uses a custom datatype named iPct. When I try to get coordinates for the points in a polyline, I get an error saying [highlight #EF2929]"Compile error: ByRef argument type missmatch"[/highlight] and it points towards the point I'm trying to measure. What I understand from the help-file in VB, there is a conflict in data types. What data type or conversion method shall I use to make it accept the point. I've previously used getMeasurable on the point elements because in my case they are not always normal points, but can be projects or datum points, and the normal getPoint method does not work on points that aren't "true" points.

I'm somewhat familiar with vba basics but this coding is a bit over my head.
(The point of malfunction is marked in green.)

'variables
Dim errorMes As Variant
Dim MeasurePoint, MeasureLength As Measurable
Dim polyline1NrOfElements, numberOfPoints As Integer
Dim foundTables, errorRep As Boolean
Dim parentName, prodName As String

Dim axisSystem1 As AxisSystem
Public selection1 As Selection
Public selectionOaxis As Selection
Public productDocument1 As Document
Public product2 As Product

Dim objGEXCELapp As Object
Dim objGEXCELwkBks As Object
Dim objGEXCELwkBk As Object
Dim objGEXCELwkShs As Object
Dim objGEXCELSh As Object

Public catTargetDrw As String
Public catHeadline As String
Public catPointIndex As String
Public catTol As String
Public catUserChoice As Integer

Public XLheadline As String
Public XLpointIndex As String
Public XLtol As String
Public XLuserChoice As Integer

Sub CATmain()

    'On Error GoTo errorHandler  'errorhandlng
        
        Set selection1 = CATIA.ActiveDocument.Selection 'handle the selection in catia
            If selection1.Count = 0 Then    'if selection is empty display message
                MsgBox ("Nothing selected! Please select a polyline or at least one point.")
                    Exit Sub
            End If
            
    'create main origin part and axissystem
    Set productDocument1 = CATIA.ActiveDocument
        Set product1 = productDocument1.Product
            
    Dim products1 As Products
    Set products1 = product1.Products
    
    Set product2 = products1.AddNewComponent("Part", "")
    
    Dim prodCount As Integer
    prodCount = products1.Count
        
    Dim prodName As Variant
    prodName = products1.Item(prodCount).PartNumber
    prodName = prodName & ".CATPart"
    
    Dim documents1 As Documents
    Set documents1 = CATIA.Documents
    
    Dim partDocument1 As PartDocument
    Set partDocument1 = documents1.Item(prodName)
    
    Dim part1 As Part
    Set part1 = partDocument1.Part
    
    Dim axisSystems1 As AxisSystems
    Set axisSystems1 = part1.AxisSystems
    
    Set axisSystem1 = axisSystems1.Add()

        'create axissystem
        axisSystem1.OriginType = catAxisSystemOriginByCoordinates
        
        Dim arrayOfVariantOfDouble1(2)
        arrayOfVariantOfDouble1(0) = 0#
        arrayOfVariantOfDouble1(1) = 0#
        arrayOfVariantOfDouble1(2) = 0#
        Set axisSystem1Variant = axisSystem1
        axisSystem1Variant.PutOrigin arrayOfVariantOfDouble1
        
        axisSystem1.XAxisType = catAxisSystemAxisByCoordinates
        
        Dim arrayOfVariantOfDouble2(2)
        arrayOfVariantOfDouble2(0) = 1#
        arrayOfVariantOfDouble2(1) = 0#
        arrayOfVariantOfDouble2(2) = 0#
        Set axisSystem1Variant = axisSystem1
        axisSystem1Variant.PutXAxis arrayOfVariantOfDouble2
        
        axisSystem1.YAxisType = catAxisSystemAxisByCoordinates
        
        Dim arrayOfVariantOfDouble3(2)
        arrayOfVariantOfDouble3(0) = 0#
        arrayOfVariantOfDouble3(1) = 1#
        arrayOfVariantOfDouble3(2) = 0#
        Set axisSystem1Variant = axisSystem1
        axisSystem1Variant.PutYAxis arrayOfVariantOfDouble3
        
        axisSystem1.ZAxisType = catAxisSystemAxisByCoordinates
        
        Dim arrayOfVariantOfDouble4(2)
        arrayOfVariantOfDouble4(0) = 0#
        arrayOfVariantOfDouble4(1) = 0#
        arrayOfVariantOfDouble4(2) = 1#
        Set axisSystem1Variant = axisSystem1
        axisSystem1Variant.PutZAxis arrayOfVariantOfDouble4
        
        part1.UpdateObject axisSystem1
        
        axisSystem1.IsCurrent = True
        
        part1.Update
        
        Dim settingControllers1 As SettingControllers
        Set settingControllers1 = CATIA.SettingControllers
        
        Dim visualizationSettingAtt1 As VisualizationSettingAtt
        Set visualizationSettingAtt1 = settingControllers1.Item("CATVizVisualizationSettingCtrl")
        
        visualizationSettingAtt1.SaveRepository
        
'***************************************************************************************************************'
    
                    mainForm.Show
            
                If catUserChoice = 1 Or catUserChoice = 2 Then  'user choose to create a polyline table
                    catPolyline
                ElseIf catUserChoice = 3 Then  'user choose to create a point table
                    catPoints
                ElseIf XLuserChoice = 1 Or XLuserChoice = 2 Then
                    XLpolyline
                ElseIf XLuserChoice = 3 Then
                    XLpoints
                End If

errorHandler:   'error messages
    If Err.Number = -2147467259 Then
        errorMes = MsgBox("No active 3D document!" & vbNewLine & "Load a 3D document and select a polyline or at least one point.", vbCritical, "Error!")
            Err.Number = 0
    End If
End Sub

Sub catPolyline()
'On Error GoTo errorHandler  'errorhandlng

            'handle the selection in catia
            'Set selection1 = CATIA.ActiveDocument.Selection
                Set polyline1 = selection1.Item(1)  'pick first element (the polyline) of the selection in Catia
                    If polyline1.Type <> "HybridShapePolyline" Then     'check if the object selected is a polyline
                        errorMes = MsgBox("Wrong type of object selected! Please select a polyline.", vbCritical, "Wrong type of object!!")
                        Exit Sub
                    End If
                    
                    Set myPolyline = polyline1.Value
                        polyline1NrOfElements = myPolyline.NumberOfElements  'count number of points in the polyline
      
'********************************************************************************************************************************
    'start table creation process
    CATIA.Windows.Item(catTargetDrw).Activate     'switch to drawing window
        Set myDoc = CATIA.ActiveDocument    'define active document and view
            Set mySheet = myDoc.Sheets.ActiveSheet
    
                For i = 1 To mySheet.Views.Count                'check if drawing view "TABLES" exists
                    Set myView = mySheet.Views.Item(i)      'set view
                        If myView.Name = "TABLES" Then             'if "TABLES" exists activate view and exit for-loop
                            Set myView = mySheet.Views.Item("TABLES")
                                myView.Activate
                                    foundTables = True
                                        Exit For
                        End If
                Next
        
                        If foundTables = False Then             'if "TABLES" doesn't exist, create it and activate
                            Set myView = mySheet.Views.Add("TABLES")
                                myView.Activate
                        End If

        'create the table itself
        Dim mytable As DrawingTable
        Set mytable = myView.Tables.Add(100, 100, polyline1NrOfElements + 3, 5, 7.5, 22)
    
            'add labels
            mytable.SetCellString 1, 1, catHeadline
            mytable.SetCellString 2, 1, "POINT"
            mytable.SetCellString 2, 2, "X"
            mytable.SetCellString 2, 3, "Y"
            mytable.SetCellString 2, 4, "Z"
            mytable.SetCellString 2, 5, "RADIUS"
                'format the table
                mytable.MergeCells 1, 1, 1, 5
                    mytable.SetCellAlignment 1, 1, CatTableTopCenter
                mytable.MergeCells polyline1NrOfElements + 3, 1, 1, 5
                    mytable.SetCellAlignment polyline1NrOfElements + 3, 1, CatTableTopCenter
'**************************************************************************************************************************************
    'coordinate extraction process
    Dim TheSPAWorkbench As Workbench
    Set TheSPAWorkbench = CATIA.ActiveDocument.GetWorkbench("SPAWorkbench") ' set TheSPAWorkbench
        Dim MeasurePoint, MeasureLength As reference
            Dim oRad As Length
                'Dim activePoint As Object
'**************************************************************************************************************************************
            If catUserChoice = 1 Then  'normal polyline
                For i = 1 To polyline1NrOfElements       'iterate through all poinst of polyline
                    myPolyline.GetElement i, activePoint, oRad
                            
                       Set MeasureLength = TheSPAWorkbench.GetMeasurable(myPolyline)
                        myPolylineLength = MeasureLength.Length
                     
                    [highlight #8AE234]LCS axisSystem1, activePoint[/highlight]                    
                    If oRad Is Nothing Then RadiusAtPoint = False Else: RadiusAtPoint = True                ' check if Radius at point
                                       
                    'add point index
                    mytable.SetCellString 2 + i, 1, catPointIndex & i
        
                    xPoint = Round(Diff.X, 1) 'check decimals
                        If xPoint = 0 Then      'avoid division with zero
                            mytable.SetCellString 2 + i, 2, "0,0"       'add "0,0"
                        ElseIf Int(xPoint) / xPoint = 1 Then        'check if integer
                            mytable.SetCellString 2 + i, 2, xPoint & ",0"       'add ",0"
                        Else
                            mytable.SetCellString 2 + i, 2, Round(Diff.X, 1)     'else, use 1 decimal
                        End If
                    
                    yPoint = Round(Diff.Y, 1)        'same procedure for y and z
                        If yPoint = 0 Then
                            mytable.SetCellString 2 + i, 3, "0,0"
                        ElseIf Int(yPoint) / yPoint = 1 Then
                            mytable.SetCellString 2 + i, 3, yPoint & ",0"
                        Else
                            mytable.SetCellString 2 + i, 3, Round(Diff.Y, 1)
                        End If
        
                    zPoint = Round(Diff.Z, 1)
                        If zPoint = 0 Then
                            mytable.SetCellString 2 + i, 4, "0,0"
                        ElseIf Int(zPoint) / zPoint = 1 Then
                            mytable.SetCellString 2 + i, 4, zPoint & ",0"
                        Else
                            mytable.SetCellString 2 + i, 4, Round(Diff.Z, 1)
                        End If
                                        
                    If RadiusAtPoint Then
                        radPoint = Round(oRad.Value, 1)     'same method as above
                            If radPoint = 0 Then
                                mytable.SetCellString 2 + i, 5, ""
                            ElseIf Int(radPoint) / radPoint = 1 Then
                                mytable.SetCellString 2 + i, 5, radPoint & ",0"
                            Else
                                mytable.SetCellString 2 + i, 5, Round(oRad.Value, 1)
                            End If
                    End If
                Next


polyLength = Round(myPolylineLength, 1)  'add length, check integer, same method as above
                    If Int(polyLength) / polyLength = 1 Then
                        mytable.SetCellString polyline1NrOfElements + 3, 1, "TOTAL LENGTH = " & polyLength & ",0" & catTol & " MM"
                    Else
                        mytable.SetCellString polyline1NrOfElements + 3, 1, "TOTAL LENGTH = " & Round(myPolylineLength, 1) & catTol & " MM"
                    End If
                    
'****************************************************************************************************************************************
                            Set selectionOaxis = productDocument1.Selection     'delete external part document with axissystem
                                selectionOaxis.Clear
                                    selectionOaxis.Add product2
                                        selectionOaxis.delete
                            selection1.Clear
                                        
                            MsgBox "Polyline coordinate table completed!"  'display message of completion