Option Explicit
'------------------------------------------------------------------------------
'---------------------------ReadPolyLineCoords v1.0---------------------------
'------------------------------------------------------------------------------
'
'Author:    Daniel Frauenrath
'Mail:      daniel.frauenrath@gmx.com
'Release:   09.04.2010
'Version:   1.0
'
'********************************************************************************
'<<<<<<<<<<<<<<<<<<<<<<<<<<Beschreibung / Discription>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'********************************************************************************
'DE:    Ließt die Koordinaten einer vom Anwender selektierten Poyline aus
'       Koordinaten werden in C:\temp\output geschrieben
'
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
'EN:
'
'*********************************************************************************
'<<<<<<<<<<<<<<<<<<<<<<<<<<Veränderungen / Change log>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'*********************************************************************************
'Autor:             Datum:          Zeile:     Modul:       Anmerkung:
'---------------------------------------------------------------------------------
'
'**********************************************************************************
'<<<<<<<<<<<<<<<<<<<<<<<<<<globale Variablen>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'**********************************************************************************
'
'
'**********************************************************************************
'<<<<<<<<<<<<<<<<<<<<<<<<<<Hauptmakro (CATMain)>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'**********************************************************************************

Sub CATMain()

    '***DEKLARATIONEN
    Dim intDocObj As Document
    Dim intSelObj As Object 'Selection
    Dim intPartObj As Part
    Dim intSelFilterStr(0)
    Dim intSelStateStr As String
    Dim intLogFileObj As File
    Const intLogFilePath = "C:\temp\PolyLineCoord.csv"
    Dim intTextStreamObj As Object
    Dim intSelPolyLineObj As HybridShapePolyline
    Dim intTextToWriteStr As String
    Dim i As Long
    Dim intPolylineElementRefObj As Reference
    Dim intPolylineRadiusRefObj As Reference
    Dim intXCoordDbl, intYCoordDbl, intZCoordDbl As Double
    Dim intPolyLinePointObj As Object
    

    Dim oElementRadius As Length
    
    '***AKTIVES DOKUMENT HOLEN
    Set intDocObj = CATIA.ActiveDocument
    
    '***ABFRAGE DATEITYP
    If TypeName(intDocObj) <> "PartDocument" Then
        MsgBox "Das aktive Part ist kein Part Dokument!" + Chr(10) + "Das Makro wird beendet", vbExclamation, "Falscher Dateityp"
        Exit Sub
    ElseIf CATIA.Windows.Count = 0 Then
        MsgBox "Es st kein Dokument geladen!" + Chr(10) + "Das Makro wird beendet", vbExclamation, "Kein Dokument geladen"
        Exit Sub
    End If
    
    '***SELEKTIONS OBJEKT INSTANZIEREN
    Set intSelObj = intDocObj.Selection
    intSelObj.Clear
    
    '***PART OBJEKT INSTANZIEREN
    Set intPartObj = intDocObj.Part
    
    '***SELEKTION DER POLYLIN
    MsgBox "Bitte wählen Sie nun die Polyline aus deren Koordinaten Sie auslesen möchten" + Chr(10) + _
            "Drücken Sie ESC um die Selektion und das Makro abzubrechen!", vbInformation, "Polyline auswählen"
    intSelFilterStr(0) = "HybridShapePolyline"
    intSelStateStr = intSelObj.SelectElement2(intSelFilterStr, "Bitte wählen Sie die Polyline aus deren Koordinaten Sie auslesen möchten / ESC zum " & _
                                              "Abbrechen", False)
    If intSelStateStr <> "Normal" Then
        MsgBox "Sie haben die Selektion abgebrochen!" + Chr(10) + "Das Makro wird beendet", vbExclamation, "Selektion abgebrochen"
        Exit Sub
    End If
    
    '***SELEKTIONSOBJEKT AN VARIABLENOBJEKT ÜBERGEBEN
    Set intSelPolyLineObj = intSelObj.Item(1).Value
    intSelObj.Clear
    
    '***LOGDATEI ERSTELLEN / DATEI FÜR SCHREIEBN ÖFFNEN
    On Error Resume Next
    Set intLogFileObj = CATIA.FileSystem.CreateFile(intLogFilePath, True)
    Set intTextStreamObj = intLogFileObj.OpenAsTextStream("ForAppending")
    If Err.Number <> 0 Then
        MsgBox "Die Logdatei konnte nicht erzeugt werden!" + Chr(10) + "Bitte stellen Sie sicher das sie auf folgendem Dateipfad " & _
                "die benötigten Schreib- und Leserechte besitzen:" + Chr(10) + Chr(10) + _
                CStr(intLogFilePath) + Chr(10) + Chr(10) + _
                "Falls Sie keine Schreib- und Leserechte besitzen ändern Sie den Pfad im Quelltext des Makros ab", vbExclamation, "Logdatei nicht erzeugt"
         Exit Sub
    End If

    
    '***TEXTHEADER ERZEUGEN
    intTextToWriteStr = "X-KOORD" & ";" & "Y-KOORD" & ";" & "Z-KOORD"
    WriteCSVFile intTextStreamObj, intTextToWriteStr


    '***PUNKTE LESEN UND SCHREIBEN
    For i = 1 To intSelPolyLineObj.NumberOfElements
        
        '***ERSTEN REFERENZPUNKT DER POLYLINE HOLEN
        intSelPolyLineObj.GetElement i, intPolylineElementRefObj, intPolylineRadiusRefObj
        
        '***REFERENZOPUNKT OBJEKT HOLEN
        Set intPolyLinePointObj = intPartObj.FindObjectByName(intPolylineElementRefObj.DisplayName)
    
        '***KOORDINATEN AUSLESEN
        intXCoordDbl = intPolyLinePointObj.X.Value
        intYCoordDbl = intPolyLinePointObj.Y.Value
        intZCoordDbl = intPolyLinePointObj.Z.Value

        '***KOORDINATEN SCHREIBEN
        intTextToWriteStr = intXCoordDbl & ";" & intYCoordDbl & ";" & intZCoordDbl
        WriteCSVFile intTextStreamObj, intTextToWriteStr
   
    Next

    '***TEXTSTRAEM SCHLIESSEN
    intTextStreamObj.Close
    
    '***OBJEKTE ZERSTOEREN
    Set intTextStreamObj = Nothing
    
    '***ANWENDERAUSGABE
    MsgBox "Die Koordinaten der Polyline " + Chr(34) + intSelPolyLineObj.Name + Chr(34) + " wurden erfolgreich ausgelesen" + Chr(10) + _
            "Es wurde eine *.csv Datei unter folgedem Pfad erzeugt:" + Chr(10) + Chr(10) + _
            CStr(intLogFilePath), vbInformation, "Makro erfolgreich beendet"
            


End Sub

'***FUNKTION ZUM SCHREIBEN DER TEXTDATEI
Private Function WriteCSVFile(ByVal uebTextStreamObj As Object, ByVal uebTextToWrite As String)

    '***ZEILE SCHREIBEN
    uebTextStreamObj.Write (uebTextToWrite + Chr(10))

End Function
