'Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long
Sub CATMain()
' ************************************************************************
' *                                                                      *
' *  TH 2012                                                             *
' *                                                   *
' *  Germany                                                             *
' ************************************************************************
'
' Purpose: keine Verzeichnise manuell auswählen, Speichername hat einen festen Syntax
'          zeichnungsvorlagen müssen nicht gesucht werden
'
' ActiveDoc: any
'
' Author: Thomas Harmening 
'
' Version:  1.00.0.0 / 01.05.2013
'
' Description:Speichen mit voreingestellten Pfaden und Auswahl von Zeichnungsvorlagen
'
' Manual:
'
' Modifications:
'-------------------------------------------------------------------------------
'   1.00.0.0 / 01.05.2012 - Thomas Harmening
'   created
' ******************************************************************************
'-------------------------------------------------------------------------
    Dim oFenster As Windows
    Dim ObjType As String
    Set oFenster = CATIA.Windows
    If oFenster.Count = 0 Then
        Box = MsgBox("Es ist kein Dokument geladen!" + Chr(10) + "Das Makro kann nicht ausgefuehrt werden und wird beendet!", vbCritical, "Keine Dokument geladen")
        Exit Sub
        End If
        Set oRoot = CATIA.ActiveDocument
        ObjType = TypeName(oRoot)
        If ObjType <> "PartDocument" Then
            If ObjType <> "DrawingDocument" Then
                Box = MsgBox("Das aktive Dokument ist kein Part!" + Chr(10) + "Und auch keine Zeichnung" + Chr(10) + "Start Dialog Zeichnenblattformat" & vbLf & vbLf & vbLf & "für das Speichern von Parts ist ein aktives Part erforderlich", _
                    vbCritical + vbOKOnly, "Falscher Dateityp")
                    
                    Call Zeichn
                Exit Sub
            End If
        End If
        ObjType = ""

On Error Resume Next

aa = InputBox("BITTE SPEICHERORT AUSWÄHLEN:" & vbLf & "1- WOP" & vbLf _
& "2 - STL" & vbLf _
& "3 - HELLER" & vbLf _
& "4 - METALLSINTERTEILE" & vbLf _
& "5 - DXF" & vbLf _
& "6 - PDF" & vbLf _
& "8 - SWAN_OUT" & vbLf _
& "9 - Neue Zeichnung", "titel")

If aa <> 5 Then
If aa = 9 Then Call Zeichn

    Set mydoc = CATIA.ActiveDocument
    Set ActivePart = CATIA.ActiveDocument '.Part
    
    Partquelle = CATIA.ActiveDocument.Part.Parent.FullName '.Part.Parent.FullName
 'aa = InStr(CATIA.ActiveDocument.name, ".")
 
     bemi = Left(CATIA.ActiveDocument.name, InStr(CATIA.ActiveDocument.name, ".") - 1)
     'bemi = Left(CATIA.ActiveDocument.Name, 13)
     Def = mydoc.GetItem(bemi).Definition
     
    If InStr(1, mydoc.GetItem(bemi).Nomenclature, "_KONS", 0) > 0 Then
                benennung = Left(mydoc.GetItem(bemi).Nomenclature, InStr(mydoc.GetItem(bemi).Nomenclature, "_KONS") - 1)
                Else
            benennung = mydoc.GetItem(bemi).Nomenclature
        End If
    
Select Case aa
    Case 1
        FPath = "Z:\A-D\AF5-WOP\"    'Z:\A-D\AF5-WOP\
    Case 2
        FPath = "Z:\A-D\AF5-RP-SIFI\"   'Z:\A-D\AF5-RP-SIFI\
    Case 3
        SpVerz = "Z:\A-D\AF5-WOP2\" & "TEAM HELLER-" & bemi & "_" & benennung & "\"
            If CATIA.FileSystem.FolderExists("Z:\A-D\AF5-WOP2\" & "TEAM HELLER-" & bemi & "_" & Def & "_" & benennung & "\") = False Then
        CATIA.FileSystem.CreateFolder (SpVerz)
        FPath = SpVerz
        End If
        
    Case 4
        SpVerz = "Z:\A-D\AF5-RP-UT\RP01_DC\" & "RP_UT-" & bemi & "_" & benennung & "\"
            If CATIA.FileSystem.FolderExists("Z:\A-D\AF5-RP-UT\RP01_DC\" & "RP_UT-" & bemi & "_" & Def & "_" & benennung & "\") = False Then
        CATIA.FileSystem.CreateFolder (SpVerz)
        FPath = SpVerz
        End If
    Case 8
    userver = Environ("USERPROFILE")

    'userver = InputBox("BITTE userid eingeben:", "titel")
        'FPath = "C:\Users\" & userver & "\Local Settings\Application Data\SWAN\CATV5_OUT\"
        FPath = userver & "\Local Settings\Application Data\SWAN\CATV5_OUT\"
    Case 6
    SAVENAME = InputBox("BITTE PDF BENENNEN:", "titel")
        SpVerz = "C:\V5_PDF\" & bemi & "_" & SAVENAME & "\"
            If CATIA.FileSystem.FolderExists("C:\V5_PDF\" & bemi & "_" & SAVENAME & "\") = False Then
        CATIA.FileSystem.CreateFolder (SpVerz)
        FPath = SpVerz
Set sh = CreateObject("WScript.Shell")
tFPath = "Explorer.exe " & FPath          'tFPath = "explorer ," & FPath
sh.Run (tFPath)

Set drawingDocument1 = CATIA.ActiveDocument

drawingDocument1.ExportData FPath & bemi & "_" & SAVENAME & ".pdf", "pdf"
        'mydoc.SaveAs FPath & bemi & SAVENAME & ".PDF"
        End If
        Exit Sub
End Select

CATIA.Application.DisplayFileAlerts = False
        mydoc.SaveAs FPath & bemi & "_" & Def & "_" & benennung & ".CATPart"
     mydoc.SaveAs Partquelle

CATIA.Application.DisplayFileAlerts = True

Set sh = CreateObject("WScript.Shell")
tFPath = "Explorer.exe " & FPath          'tFPath = "explorer ," & FPath
sh.Run (tFPath)

'Shell "explorer ,/select," & FPath, vbNormalFocus

Else
ben = InputBox("BITTE BENENNUNG AUSWÄHLEN:")
Set drawingDocument1 = CATIA.ActiveDocument
Partquelle = Left(CATIA.ActiveDocument.name, 13)
dxf = CATIA.ActiveDocument.name
drawingDocument1.ExportData "C:\V5_DXF\" & dxf & "_" & ben & ".dxf", "dxf"
Set sh = CreateObject("WScript.Shell")
tFPath = "Explorer.exe " & "C:\V5_DXF\"         'tFPath = "explorer ," & FPath
sh.Run (tFPath)
End If

End Sub

Sub Zeichn()
Dim documents1 As Documents
        Set documents1 = CATIA.Documents

        zeichngr = InputBox("BITTE BLATTGRÖSSE AUSWÄHLEN:" & vbLf & "0 - A0" & vbLf & "1 - A1" & vbLf & "2 - A2" & vbLf & "3 - A3" & vbLf & "4 - A4" & vbLf & "5 - Formgrundlage", "titel")

            If TypeName(zeichngr) = "Empty" Then Exit Sub '"String"
        
        Dim drawingDocument1 As DrawingDocument

        Select Case zeichngr
        Case 0
Set drawingDocument1 = documents1.Open("Z:\Template\V5_ZEICHNUNGSVORLAGEN\A0.CATDrawing")
    Case 1
Set drawingDocument1 = documents1.Open("Z:\Template\V5_ZEICHNUNGSVORLAGEN\A1.CATDrawing")
    Case 2
Set drawingDocument1 = documents1.Open("Z:\Template\V5_ZEICHNUNGSVORLAGEN\A2.CATDrawing")
    Case 3
Set drawingDocument1 = documents1.Open("Z:\Template\V5_ZEICHNUNGSVORLAGEN\A3.CATDrawing")
    Case 4
Set drawingDocument1 = documents1.Open("Z:\Template\V5_ZEICHNUNGSVORLAGEN\A4.CATDrawing")
    Case 5
Set drawingDocument1 = documents1.Open("Z:\Template\Startdrawing_Formgrundlagen_V1.0.19.CATDrawing")
End Select
                    
        Exit Sub
End Sub