' Das Originalmakro stammt aus
' http://ww3.cad.de/foren/ubb/Forum137/HTML/000586.shtml
' es wurde hier angepasst um es ggf. in den
' GSD_PointSplineLoftFromExcel.xls von Dassault einzufügen

'Man markiert im GSD die auszulesenden Punkte und führt das Script aus

Const cDateiPfad = "/tmp/Punkt_test_exp.txt" 
' Ich lege für den schnellen Zugriff meine Datei auf den Desktop
' Dateipfad nach eigenem Ermessen ändern 
' Existiert die Date bereits? 
Function fFileExist() as Integer 
   On Error Resume Next 
   CATIA.FileSystem.GetFile (cDateiPfad) 
   fFileExist = Err.Number 
End Function 
 
Sub CATMain() 
 
' Datei erzeugen 
  Dim Datei as File 
 
  If   fFileExist() <> 0 then  
   Set Datei = CATIA.FileSystem.CreateFile (cDateiPfad, False) 
    Else  
   Set Datei = CATIA.FileSystem.GetFile (cDateiPfad) 
  End If 
 
  Dim mySelection as Selection 
  Set mySelection = Catia.ActiveDocument.Selection 
 
  Dim AnzahlSelekt as integer 
  AnzahlSelekt = mySelection.count   ' Gibt an wieviele Elemente selektiert wurden 
 
  Dim DStrom as TextStream 
  Set DStrom = Datei.OpenAsTextStream ("ForAppending") 
 
   DStrom.Write (";" &Chr(10)& ";" & "Punkteausgabe mit editierten Macro von Online GmbH/ B.Friedrich" & Chr(10)& Chr(10))
   DStrom.Write ("START" & Chr(10))
   DStrom.Write ( "Element" & ";" & "X-Koordinate" & ";" & "Y-Koordinate" & ";" & "Z-Koordinate" & Chr(10))
 
  Dim I as integer 
  Dim oPunktKoord(2) as CATSafeVariant  
  Dim oSelElem as Object 
 
  For I = 1 to AnzahlSelekt 
   
   Set oSelElem = mySelection.Item(I) 
   oSelElem.Value.GetCoordinates (oPunktKoord)
   text = oPunktKoord(0) &  ";" & oPunktKoord(1) &  ";" & oPunktKoord(2) 
        'text = replace(text, ","  , ".") 'falls Dezimalpunkte erforderlich sind
  
 
 DStrom.Write (mySelection.Item(I).Value.name &";" & oPunktKoord(0)& ";"& oPunktKoord(1)&";"& oPunktKoord(2) &";" &Chr(10))
' Die Wertetabelle kann in Excel importiert werden. Wichtig dabei ist eine Dezimaltrennung mit Kommata!!!
 
  Next 
  DStrom.Write ("ENDE" & Chr(10)& Chr(10)& Chr(10))

  DStrom.Close 
 
 
End Sub