' ==============================================================
' Purpose: Code to create a text file in CATReport folder and write CATDrawing points coordinates inside , all from active view
' Usage: 1 - A CATDrawing document must be active
' 2 - Run macro
' Author: modifed by ferdo, originator unknown (Disclaimer: You use this code at your own risk)
' ===============================================================
Sub CATMain()
Dim documents1 'As Documents
Dim drawDocument1 'As DrawingDocument
Dim DrawSheets1 'As DrawingSheets
Dim DrawSheet1 'As DrawingSheet
Dim GeoEle 'As GeometricElements
Dim ele 'As Point2D
On Error Resume Next
' Code to create and write in a file
' The resulting file its not so fine, I don't have time to make it look better....
Dim sPath As String
Dim sTime As String
Dim sName As String
Dim sFile As String
documentname = CATIA.ActiveDocument.Name
position = InStr(documentname,".CATDrawing")
position = position -1
documentname = Left(documentname,position)
sPath = "c:\Temp\"
'~ sPath = CATIA.Application.SystemService.Environ("CATReport")
sName = "\XYDrawing_" & documentname & ".TXT"
sFile = sPath & sName
Set oFileOut = CATIA.FileSystem.CreateFile(sFile,TRUE)
Dim oStream As TextStream
Set oStream = oFileOut.OpenAsTextStream("ForWriting")
' Code for Points
Set documents1 = CATIA.Documents
Set drawDocument1 = CATIA.ActiveDocument
Set DrawSheets1 = drawDocument1.Sheets
Set DrawSheet1 = DrawSheets1.ActiveSheet
Set DrawViews = DrawSheet1.Views
Set DrawView1 = DrawViews.ActiveView
Set GeoEle = DrawView1.GeometricElements
For i = 1 To GeoEle.Count
Set ele = GeoEle.Item(i)
Dim coord(1)
if ele.GeometricType = 2 then ' GeometricElement 2 = CatGeotypePoint2D
ele.GetCoordinates coord
' change value in inch if you want, just delete ' (the comment sign)
coord(0) = coord(0)'/25.4
coord(1)=coord(1)'/25.4
end if
Set Point(i) = GeoEle.Item(i).Value
oStream.Write (ele.Name&" :"&coord(0)&" , "&coord(1))
Next
oStream.close
MsgBox "Check the file : " & sFile, vbInformation ' information about where is the file
End Sub