VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} Create_Points_mit_Excel 
   Caption         =   "Punkte mit Koordianten aus Excel erstellen"
   ClientHeight    =   1815
   ClientLeft      =   45
   ClientTop       =   375
   ClientWidth     =   7440
   OleObjectBlob   =   "Create_Points_mit_Excel.frx":0000
   StartUpPosition =   1  'Fenstermitte
End
Attribute VB_Name = "Create_Points_mit_Excel"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' Makro:        Create_Points_mit_Excel
' Version:      1.0
' Catia Level:  V5R19
' UIL:          English (User Interface Language)
' Autor:        Christian Obholzer
' E-Mail:       ch.obholzer@aon.at
' Erstellt:     30.09.2010
' Zweck:        Es werden Punkte mit den Koordianten aus einem Excelfile erstellt
'-----------------------------------------------------------------------------------
' Änderungen:   Datum, Name
'               Hier wird die Änderung angegeben
'               Datum, Name
'               Hier wird die Änderung angegeben
'-----------------------------------------------------------------------------------

Option Explicit
    
    '***Deklarationen
    Public objWindows As Windows
    Public objDoc As Document
    Public strTyp As String
    Public vntOeffnen As Variant
    Public strPfad As String
    Public objExcel As Object
    Public WB As Workbook
    Public Wzk3D As HybridShapeFactory
    Public GeoSet As HybridBody
    Public objBody As HybridBody
    Public HBodies As HybridBodies
    Public objPart As Part
    Public Points As HybridShapePointCoord
    Public intI As Integer
    Public sngX As Single
    Public sngY As Single
    Public sngZ As Single

Private Sub cmd_Beenden_Click()

    '***Fenster schließen
    Unload Me
    
End Sub
Private Sub cmd_Dateiauswahl_Click()

    '***Excelfile über SelectionBox auswählen
    vntOeffnen = CATIA.FileSelectionBox("Excelfile auswählen", "*.xls; *.xlsx", CatFileSelectionModeOpen)
    
    '***Dateipfad in TextBox anzeigen
    strPfad = vntOeffnen
    Me.txt_Pfad.Text = strPfad
    
    '***Button aktivieren
    Me.cmd_Punkte_erstellen.Enabled = True
    
End Sub

Private Sub cmd_Excel_oeffnen_Click()

    On Error Resume Next

    '***Datei ohne speichern schließen
    WB.Close False

    '***Excel beenden
    objExcel.Application.Quit

End Sub

Private Sub cmd_Excel_schließen_Click()
    
    '***Meldung an User, wenn keine Datei ausgewählt wurde
    If strPfad = "" Then
        MsgBox "Es wurde keine Datei ausgewählt", vbCritical + vbOKOnly, "Fehlende Datei"
        Exit Sub
    End If
    
    '***Excel starten
    Set objExcel = CreateObject("Excel.Application")
    
    '***Excel sichtbar schalten
    objExcel.Application.Visible = True
    
    '***Datei öffnen
    Set WB = objExcel.Workbooks.Open(strPfad)

End Sub

Private Sub cmd_Punkte_erstellen_Click()

    On Error GoTo Fehler

    '***Fenster ausblenden
    Me.Hide

    '***Abfrage nach geöffnetem Dokument
    Set objWindows = CATIA.Windows
    If objWindows.Count = 0 Then
        MsgBox "Es ist kein Dokument geöffnet." & vbNewLine & _
        "Das Makro kann nicht ausgeführt werden und wird beendet.", vbCritical + vbOKOnly, "Kein Dokument offen"
        Exit Sub
    End If

    '***Auslesen der Dokumentart
    Set objDoc = CATIA.ActiveDocument
    strTyp = TypeName(objDoc)
    If strTyp <> "PartDocument" Then
        MsgBox "Dieses Dokument ist kein Drawing." & vbNewLine & _
        "Das Makro kann nicht ausgeführt werden und wird beendet.", vbCritical + vbOKOnly, "Falscher Dokumententyp"
        Exit Sub
    End If
    
    '***Excel starten
    Set objExcel = CreateObject("Excel.Application")
    
    '***Excel nicht sichtbar schalten
    objExcel.Application.Visible = False
    
    '***Datei öffnen
    Set WB = objExcel.Workbooks.Open(strPfad)
    
    Set objPart = objDoc.Part
    Set Wzk3D = objPart.HybridShapeFactory
    Set objBody = objPart.HybridBodies.Add
    '***Geometrisches Set umbenennen
    objBody.Name = "Punkte"
    
    '***Element ansprechen
    Set GeoSet = objPart.HybridBodies.Item("Punkte")
    
    '***Beginn der Koordinaten im Excelfile
    intI = 4
    
    Do
        '***Koordinaten einlesen
        sngX = CSng(objExcel.Cells(intI, 2).Value)
        sngY = CSng(objExcel.Cells(intI, 3).Value)
        sngZ = CSng(objExcel.Cells(intI, 4).Value)
        
        '***Punkte erstellen
        Set Points = Wzk3D.AddNewPointCoord(sngX, sngY, sngZ)
        
        'Eemente dem Geometrischen Set "Flaechenoperationen" zuordnen
        GeoSet.AppendHybridShape Points
        
        '***Punkte benennen
        Points.Name = objExcel.Cells(intI, 1).Value
    
        '***Zeilen hochzählen
        intI = intI + 1
        
        '***Part updaten
        objPart.Update
        
    Loop While (objExcel.Cells(intI, 2).Value <> "")
    
    '***Excel beenden
    objExcel.Application.Quit
    
    '***Fenster schließen
    Unload Me
    
    '***Meldung an User
    MsgBox "Makro wurde erfolgreich beendet.", vbInformation + vbOKOnly, "Makro erfolgreich beendet"
    
Exit Sub

'***Fehlerbehandlung: Ausgabe der Fehlernummer und Fehlerbeschreibung
Fehler:
    MsgBox "Fehlernummer: " & Err.Number & vbNewLine & _
    "Fehlerbeschreibung: " & Err.Description, vbCritical + vbOKOnly, "Fehler"
    
End Sub

Private Sub UserForm_Click()

End Sub
