Sub CATMain()

'****Abfrage Dokumente****
    Set oFenster = CATIA.Windows
    If oFenster.Count = 0 Then
        Box = MsgBox("Es ist kein Dokument geladen!" + Chr(10) + "Das Makro kann nicht ausgeführt werden und wird beendet!", vbCritical, "Keine Dokument geladen")
        Exit Sub
    End If
    Set aktiDoc = CATIA.ActiveDocument
    ObjType = TypeName(aktiDoc)
    If ObjType <> "PartDocument" Then
        Box = MsgBox("Das aktiv geladen Dokument ist KEIN CATPart!" + Chr(10) + _
                    "Bitte aktivieren sie ein CATPart und starten sie das Makro erneut!", _
                    vbExclamation, "Abbruch falscher Dateityp")
        Exit Sub
    End If
    
'***Dateiname des Screenshots***
    'Dim oFileSys As FileSystem
    Set oFileSys = CATIA.FileSystem
    oPfad = "C:\Dokumente und Einstellungen\Daniel\Desktop\CAD.de\Screenshots\"
'    If (Not oFileSys.FolderExists(oPfad)) Then
'       Box = MsgBox("Der angegebene Ordner existiert nicht!" + Chr(10) + _
'       "Bitte aendern Sie den Quelltext in Zeile X", vbCritical + vbOKOnly, "Speicherpfad")
'       Exit Sub
'    End If
    oFileNameRAW = oPfad & aktiDoc.Product.Name + "_Screenshot_"

'***Allgemeine Definitionen***
    Set oDoc = CATIA.ActiveDocument
    Set oPart = oDoc.Part
    Set oRel = oPart.Relations
    
'***Definition Suche***
    Dim mySel As Selection
    Dim was(0)
    Dim Auswahl
    Set mySel = oDoc.Selection
    was(0) = "DesignTable"
    mySel.Clear
'    Auswahl = mySel.SelectElement2(was, "Bitte wählen Sie eine Design Tabelle aus.", False)
'    If Auswahl = "Normal" Then
'        oSelName = mySel.Item(1).Value.Name
'    Else
'        Box = MsgBox("Sie haben die Selektion abgebrochen" + Chr(10) + "Das Makro wird nun beendet!", vbCritical, "Abbruch durch Nutzer")
'        Exit Sub
'    End If

'***Umgebung für Screenshot holen
    Set aktiWin = CATIA.ActiveWindow
    Set oViewer = aktiWin.ActiveViewer
    
'***Hintergrundfarbe ändern (weiß)***
    Dim color(2)
    oViewer.GetBackgroundColor color
    oViewer.PutBackgroundColor Array(1, 1, 1)
    
'***Abfrage Kamera***
    OriCamName = "Camera1"
    Set oCams = oDoc.Cameras
    For j = 1 To oCams.Count
        CamName = oCams.Item(j).Name
        If CamName = OriCamName Then
            CamChecker = True
            Set aktiCam = oCams.Item(j)
            Set oViewPoint = aktiCam.Viewpoint3D
            oViewer.Viewpoint3D = oViewPoint
            CATIA.StatusBar = ("Es wurde folgende Carmera im Dokument identifiziert: " & OriCamName & _
            " Diese wird nun angewendet")
            Exit For
        End If
    Next
    
    If CamChecker <> True Then
        Box = MsgBox("Es wurde keine Ansicht mit dem Namen " & OriCamName & " im Dokument gefunden!" _
                    + Chr(10) + "Bitte erstellen sie eine Named View mit dem Namen " & OriCamName & _
                    " und starten sie das Makro erneut." + Chr(10) + _
                    "Das Makro wird nun beendet!", vbCritical, "Keine Camera im Dokument")
        Abfrage = MsgBox("Wollen Sie nun den Named View Command starten?", vbExclamation + vbYesNo, "Neue Camera erstellen?")
            If Abfrage = vbYes Then
                CATIA.StartCommand ("Named Views")
            End If
        Exit Sub
    End If
        

'****Einstellungen der Ansicht***
    oViewer.RenderingMode = catRenderShadingWithEdges
    'oViewer.Viewpoint3D = CATIA.ActiveDocument.Cameras.Item(2) 'Front View
    aktiWin.Layout = catWindowGeomOnly

'***Schleife für Screenshots***
'Set oTable = oRel.Item(oSelName)
Set oTable = oRel.Item("DesignTable.4") 'hier noch den richtigen Namen eintragen!!!
OriConfig = oTable.Configuration
Box = MsgBox("Sie haben folgende DesignTable ausgewählt" & oTable.Name, vbInformation, "Hinweis")

For i = 1 To oTable.ConfigurationsNb
    oFileName = oFileNameRAW & i
    oTable.Configuration = i
    oPart.Update
    oViewer.Reframe
    CATIA.ActiveWindow.ActiveViewer.CaptureToFile catCaptureFormatJPEG, oFileName & ".jpg"
Next
oTable.Configuration = OriConfig

'***Hintergrund zurücksetzen***
    oViewer.PutBackgroundColor color
    aktiWin.Layout = catWindowSpecsAndGeom

'***Abschluss***

Box = MsgBox("Das Makro wurde erfolgreich beendet!" + Chr(10) + "Die Screenshots wurden unter folgendem Pfad abgespeichert" + Chr(10) + "==> " & oPfad & " <==", vbInformation, "Makro erfolgreich beendet")
    
End Sub