' 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
Close
MsgBox "Check the file : " & sName, vbInformation ' information about job done
End Sub
