×
INTELLIGENT WORK FORUMS
FOR ENGINEERING PROFESSIONALS

Contact US

Log In

Come Join Us!

Are you an
Engineering professional?
Join Eng-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Eng-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

SCIRPTS AND MACROS

XYZ of points to a text file by itsmyjob
Posted: 16 Aug 07 (Edited 23 May 17)

CODE

' 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 

Back to DASSAULT: CATIA products FAQ Index
Back to DASSAULT: CATIA products Forum

My Archive


Resources

Low-Volume Rapid Injection Molding With 3D Printed Molds
Learn methods and guidelines for using stereolithography (SLA) 3D printed molds in the injection molding process to lower costs and lead time. Discover how this hybrid manufacturing process enables on-demand mold fabrication to quickly produce small batches of thermoplastic parts. Download Now
Design for Additive Manufacturing (DfAM)
Examine how the principles of DfAM upend many of the long-standing rules around manufacturability - allowing engineers and designers to place a part’s function at the center of their design considerations. Download Now
Taking Control of Engineering Documents
This ebook covers tips for creating and managing workflows, security best practices and protection of intellectual property, Cloud vs. on-premise software solutions, CAD file management, compliance, and more. Download Now

Close Box

Join Eng-Tips® Today!

Join your peers on the Internet's largest technical engineering professional community.
It's easy to join and it's free.

Here's Why Members Love Eng-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close