Sub CATMain()

'written by Daniel Frauenrath
'modified by Juergen Dahm
'only for www.cad.de

'****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***
    oPfad = "D:\INNOTRANS_2008\"
    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 fuer Screenshot holen
    Set aktiWin = CATIA.ActiveWindow
    Set oViewer = aktiWin.ActiveViewer
    
'***Hintergrundfarbe Aendern (weiss)***
    Dim color(2)
    oViewer.GetBackgroundColor color
    oViewer.PutBackgroundColor Array(1, 1, 1)

'****Einstellungen der Ansicht***
    oViewer.RenderingMode = catRenderMaterial
    aktiWin.Layout = catWindowGeomOnly

'***Schleife fuer Screenshots***
Set oTable = oRel.Item(oSelName)
For i = 1 To oTable.ConfigurationsNb
    oFileName = oFileNameRAW & i
    oTable.Configuration = i
    oPart.Update
    oViewer.Reframe
    CATIA.ActiveWindow.ActiveViewer.CaptureToFile catCaptureFormatJPEG, oFileName & ".jpg"
Next

'***Hintergrund zuruecksetzen***
    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