XYZ of points to a text file

XYZ of points to a text file by itsmyjob

' Script for CATIA V5 R14 SP4
' Writer : Eric Neuville for CATIA forums
' This scipt scan a Geometrical Set named 'Points' in a Part
' Then get XYZ of points (values in mm)
' and create a report as a Text file located in d: drive
' version 1.01
'               change on the dim aCoordinates in order to have 4 elements (0 = X, 1=Y ,2=Z ,3=PointName)
'               change in Sub WriteTxTFile in order to order result properly ( Name, x, y, z ) in file
' version 1
'               work with Geometrical Set only
'               do not works with OGS, HybridBodies, or Geometrical set in Bodies
'               work with Points only
'               do not work with Sketches, intersection, projection, transformations...
'version 2
'               Updated to V5R20 SP2 
'               Added a function to check if the point was already identified in order to remove duplicate in the output file

Sub CATMain()

Dim oPartDoc As Part
Dim oHBs As HybridBodies
Dim oHSs As HybridShapes
Dim TheSPAWorkbench As Workbench
Dim oRef As Point
Dim referenceObject As Reference
Dim TheMeasurable As Variant
Dim aCoordinates(2) As Variant
Dim aToExport(5000, 3) As Variant
Dim iNumberOfPoint As Integer

On Error Resume Next

Set oPartDoc = CATIA.ActiveDocument.Part    ' get the active doc as a Part
Set oHBs = oPartDoc.HybridBodies            ' define the geometrical set collection

If Err.Number <> 0 Then                     ' if not a part or no geometrical set then end

Message = MsgBox("Sorry, This script works with a CATPart as Active document", vbCritical, "Error")
Exit Sub

End If

Set TheSPAWorkbench = CATIA.ActiveDocument.GetWorkbench("SPAWorkbench")  ' get the SPA workbench in order to get coordinates

Set oHSs = oHBs.GetItem("Points").HybridShapes    ' get the HybridShape collection

For i = 1 To oHSs.Count                 ' go thru all HybridShape in geometrical set
Set oRef = oHSs.Item(i)
Set referenceObject = oPartDoc.CreateReferenceFromGeometry(oRef)    ' set reference in order to use Measurable
Set TheMeasurable = TheSPAWorkbench.GetMeasurable(referenceObject)  ' set Measurable with reference
TheMeasurable.GetPoint aCoordinates                                 ' get coordinates from Measurable

If Err.Number = 0 Then                                              ' if reference is point then

            If IsDuplicate(iNumberOfPoint, aToExport, aCoordinates) = False Then
                iNumberOfPoint = iNumberOfPoint + 1                     ' count the number of point
                aToExport(iNumberOfPoint, 3) = oRef.Name                ' get the name of point in array
                For U = 0 To 2
                aToExport(iNumberOfPoint, U) = aCoordinates(U)          ' get coordinates in array
                Next U
            End If
 End If
 Err.Clear                                                          ' reset error to 0
Next i                                  ' next hybridshape

WriteTxTFile iNumberOfPoint, aToExport      ' sent array to file using sub()

End Sub

Function IsDuplicate(ArraySize As Integer, Point_array() As Variant, newPoint()) As Boolean

Dim returnvalue As Boolean

returnvalue = False

For i = 1 To ArraySize

If newPoint(0) = Point_array(i, 0) And newPoint(1) = Point_array(i, 1) And newPoint(2) = Point_array(i, 2) Then returnvalue = True
Next i

IsDuplicate = returnvalue

End Function

Sub WriteTxTFile(iNumber As Integer, XYZ_array() As Variant)

Dim sTime As String
Dim sName As String

sTime = Replace(Time, ":", "-")
sName = "d:\" & Left(CATIA.ActiveDocument.Name, Len(CATIA.ActiveDocument.Name) - 8) & "-" & sTime & ".txt"

Open sName For Output As #1                                             ' open file for writting

Write #1, "Points Extraction from CATIA"                                ' write in file

Write #1,
Write #1, "Name , X , Y, Z"
Write #1,

For A = 1 To iNumber
Write #1, XYZ_array(A, 3), XYZ_array(A, 0), XYZ_array(A, 1), XYZ_array(A, 2) ' write in file name and coordinate from array
Next A


MsgBox "Check the file : " & sName, vbInformation                       ' information about job done

End Sub