Multiple CatDrawing to Tif 2

[LuKeUmbo]

Hi to all, I need to export many CatDrawing to tif.
I want to set a directory for input and output. Drawings may contain multiple sheets
I have 2 scripts (see attachments) that do partially this work.
One script can manage multiple sheets but convert only 1 file and it need to be open.
The other script don't need that the Drawings are open but it don't manage multiple sheets and convert only the active sheet.

Is there a way to "merge" these script to do the whole work?
I don't know vba or scripting so I can't understand if it's possible to do.

p.s.: sorry for my english

Thanks
LuKe

 

[LINGSHUYING]

Hello all,

Here is a more clearly and concisely version of VBA Macro programming I wrote recently,
it can convert all the CatDrawings to Tif or custom select format.
It also has a lot of other features.

1 wish I could help you.

Here is my Frame,maybe you can design an interface that looks better:

Here is my Code:

[b]'[COLOR=#4E9A06]**************************************
'CopyRight by lingshuying
'Date:15-JAN-19
'language:CATIA VBA
'contact >>> WeChat Official Account ID :lingshuying1991
'**************************************[/[/color][/b]

  Sub CATMain()
    'set userform1 is modaless,then we can operate on CATIA Window
    UserForm1.Show 0
    End Sub

  [COLOR=#4E9A06]'*********************************************************************************************[/color]

  [COLOR=#4E9A06] 'Declare Basic  variable
[/color]    Public CATIA As INFITF.Application
    Public oDrawingDoc As DrawingDocument
   [COLOR=#4E9A06] '*********************************************************************************************
    ' Input and Run
[/color]    Sub CommandButton_RunToConvert_Click()
        On Error Resume Next
      [COLOR=#4E9A06]  'Connet to CATIA Application
[/color]        Set CATIA = GetObject(, "CATIA.Application")
        [COLOR=#4E9A06]'Declare first OptionButton : Convert a CATDrawingdoc that had been opened  in CATIA.
[/color]        If OptionButton_OpenDrwDoc.Value = True Then
            Set oDrawingDoc = CATIA.ActiveDocument
            Call HandleExport
        [COLOR=#4E9A06]'Declare second OptionButton : Convert a CATDrawingdoc that select from a folder .
[/color]        ElseIf OptionButton_SelectDrwDoc.Value = True Then
            Dim ModelPath As String
            Call BrowseForFolderDialogBox_ModelPath(ModelPath)
            Call HandleExport
       [COLOR=#4E9A06] 'Declare third OptionButton : Select  a folder ,then convert all the  CATDrawingdocs in it.
[/color]        ElseIf OptionButton_SelectFolder.Value = True Then
            Dim FolderPath As String
            Call BrowseForFolderDialogBox_FolderPath(FolderPath, _
            "Please select a folder to convert all the Drawingdocs in it :")
            Dim oFileSystem, oFolderPath, oFiles, oFile, ModelPath1 As String
            Set oFileSystem = CreateObject("Scripting.FileSystemObject")
            Set oFolderPath = oFileSystem.GetFolder(FolderPath)
            Set oFiles = oFolderPath.Files
            For Each oFile In oFiles
                If Right(oFile.Name, 10) = "CATDrawing" Then
                    ModelPath1 = oFolderPath & "\" & oFile.Name
                Set oDrawingDoc = CATIA.Documents.Open(ModelPath1)
                Call HandleExport
                End If
            Next
        End If
       [COLOR=#4E9A06] 'Use msgbox to show Format Convert Result
[/color]        MsgBox "All the work has been done !", _
        vbInformation + vbOKOnly, "@ LSY " & Date & " " & Time & " >>> Format Convert Result"
    End Sub
   [COLOR=#4E9A06] '*********************************************************************************************
    ' Export
[/color]    Sub HandleExport()
    On Error Resume Next
    [COLOR=#4E9A06]'Check the Sheets name in Drawingdocument,if duplicate,then rename it.
[/color]        [COLOR=#4E9A06]'Dim j As Integer, k As Integer
            'For j = 1 To oDrawingDoc.Sheets.Count
                'For k = 1 To oDrawingDoc.Sheets.Count
                    'oDrawingDoc.Sheets.Item(k).Activate
                    'If j <> k And oDrawingDoc.Sheets.Item(j).Name = oDrawingDoc.Sheets.Item(k).Name Then
                       ' oDrawingDoc.Sheets.Item(j).Name = oDrawingDoc.Sheets.Item(j).Name & "_Raname_" & j
                    'End If
                'Next
            'Next
        'select the optional button to get the folder path to save the Drawing documents
[/color]        Dim oFileName As String, oFormat As String, i As Integer, oFolderPath As String
        If OptionButton_InputFolderPath.Value = True Then
            If TextBox_ExportFolderPath.Text <> "" Then
                oFolderPath = TextBox_ExportFolderPath.Text
            Else
                MsgBox "Please input a Folder Path to save the convert result !", _
                vbInformation + vbOKOnly, "@ LSY " & Date & " " & Time & " >>> Input Prompt"
                End
            End If
        Else
                Call BrowseForFolderDialogBox_FolderPath(oFolderPath, "Please select a folder to save : ")
        End If
        
      [COLOR=#4E9A06]  'select the optional button to decide the covert format
[/color]        If OptionButton_ConvertTotif.Value = True Then
            oFormat = "tif"
        ElseIf OptionButton_ConvertTojpg.Value = True Then
            oFormat = "jpg"
        ElseIf OptionButton_ConvertTopdf.Value = True Then
            oFormat = "pdf"
            oFileName = oFolderPath & "\" & Left(oDrawingDoc.Name, Len(oDrawingDoc.Name) - 11) _
                                 & "." & oFormat
            On Error Resume Next
            Kill oFileName
            oDrawingDoc.ExportData oFileName, oFormat
            GoTo FlagLine
        ElseIf OptionButton_ConvertTodwg.Value = True Then
            oFormat = "dwg"
        End If
        
      [COLOR=#4E9A06]  'convert all the sheets in drawing
[/color]         For i = 1 To oDrawingDoc.Sheets.Count
                oDrawingDoc.Sheets.Item(i).Activate
                oFileName = oFolderPath & "\" & Left(oDrawingDoc.Name, Len(oDrawingDoc.Name) - 11) _
                                     & "_" & oDrawingDoc.Sheets.Item(i).Name & "." & oFormat
                On Error Resume Next
                Kill oFileName
                If oDrawingDoc.Sheets.Item(i).IsDetail = False Then
                    oDrawingDoc.ExportData oFileName, oFormat
                End If
        Next
                'Close the document when the convert work has been done.
FlagLine:   oDrawingDoc.Update
                oDrawingDoc.Close
    End Sub
   [COLOR=#4E9A06] '*********************************************************************************************
[/color]    Private Sub CommandButton_Exit_Click()
        End
    End Sub
    [COLOR=#4E9A06]'*********************************************************************************************
    ' Browse For Folder DialogBox to get CATDrawinDoc's Path
[/color]    Function BrowseForFolderDialogBox_ModelPath(ModelPath As String)
        On Error Resume Next
       [COLOR=#4E9A06] 'Connect to CATIA Application
[/color]        Set CATIA = GetObject(, "CATIA.Application")
        If Err.Number <> 0 Then
            Set CATIA = CreateObject("CATIA.Application")
            CATIA.Visible = True
        End If
        [COLOR=#4E9A06]' Declare  ModlePath
[/color]        ModelPath = CATIA.FileSelectionBox("Select the PartDocument file you wish Open", _
                                                                      "*.CATDrawing", CatFileSelectionModeOpen)
        If ModelPath <> "" Then
            Set oDrawingDoc = CATIA.Documents.Open(ModelPath)
        Else
            MsgBox "Please Select a drawing", _
            vbInformation + vbOKOnly, "@ LSY " & Date & " " & Time & " >>> Select Prompty"
        End If
    End Function
    [COLOR=#4E9A06]'*********************************************************************************************
    ' Browse For Folder DialogBox to get Folder's Path where store the CATDrawingsDoc
[/color]    Function BrowseForFolderDialogBox_FolderPath(FolderPath As String, Optional strTitle As String)
        Const WINDOW_HANDLE = 0
        Const NO_OPTIONS = &H1
        Dim objShellApp
        Dim objFolder
        Set objShellApp = CreateObject("Shell.Application")
        Set objFolder = objShellApp.BrowseForFolder(WINDOW_HANDLE, strTitle, NO_OPTIONS)
         If Not objFolder Is Nothing Then
            FolderPath = objFolder.Items().Item().Path
        Else
            MsgBox "You choose to cancel. This will stop this script."
        End If
            Set objShellApp = Nothing
            Set objFolder = Nothing
    End Function

 

[LuKeUmbo]

Maybe you can provide us the .Catvba project or the frame file so we don't have to reconnect the various button to the code.

In any case thank you a lot for your great work.

 

[iscariot]

I like the interface, simple and effective, no bullshit.

 

[LuKeUmbo]

Hi, meanwhile I tried to recreate the project with form and the provided code but it don't work.
Something happen but without success.
There's a possibility to hae the .Catvba code?

Thanks

 

[LuKeUmbo]

up