×
INTELLIGENT WORK FORUMS
FOR ENGINEERING PROFESSIONALS

Log In

Come Join Us!

Are you an
Engineering professional?
Join Eng-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Eng-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Jobs

Multiple CatDrawing to Tif
2

Multiple CatDrawing to Tif

Multiple CatDrawing to Tif

(OP)
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 :p

Thanks
LuKe

RE: Multiple CatDrawing to Tif

2
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:

CODE --> VBA

'**************************************
'CopyRight by lingshuying
'Date:15-JAN-19
'language:CATIA VBA
'contact >>> WeChat Official Account ID :lingshuying1991
'**************************************[/

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

  '*********************************************************************************************

   'Declare Basic  variable
    Public CATIA As INFITF.Application
    Public oDrawingDoc As DrawingDocument
    '*********************************************************************************************
    ' Input and Run
    Sub CommandButton_RunToConvert_Click()
        On Error Resume Next
        'Connet to CATIA Application
        Set CATIA = GetObject(, "CATIA.Application")
        'Declare first OptionButton : Convert a CATDrawingdoc that had been opened  in CATIA.
        If OptionButton_OpenDrwDoc.Value = True Then
            Set oDrawingDoc = CATIA.ActiveDocument
            Call HandleExport
        'Declare second OptionButton : Convert a CATDrawingdoc that select from a folder .
        ElseIf OptionButton_SelectDrwDoc.Value = True Then
            Dim ModelPath As String
            Call BrowseForFolderDialogBox_ModelPath(ModelPath)
            Call HandleExport
        'Declare third OptionButton : Select  a folder ,then convert all the  CATDrawingdocs in it.
        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
        'Use msgbox to show Format Convert Result
        MsgBox "All the work has been done !", _
        vbInformation + vbOKOnly, "@ LSY " & Date & " " & Time & " >>> Format Convert Result"
    End Sub
    '*********************************************************************************************
    ' Export
    Sub HandleExport()
    On Error Resume Next
    'Check the Sheets name in Drawingdocument,if duplicate,then rename it.
        '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
        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
        
        'select the optional button to decide the covert format
        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
        
        'convert all the sheets in drawing
         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
    '*********************************************************************************************
    Private Sub CommandButton_Exit_Click()
        End
    End Sub
    '*********************************************************************************************
    ' Browse For Folder DialogBox to get CATDrawinDoc's Path
    Function BrowseForFolderDialogBox_ModelPath(ModelPath As String)
        On Error Resume Next
        'Connect to CATIA Application
        Set CATIA = GetObject(, "CATIA.Application")
        If Err.Number <> 0 Then
            Set CATIA = CreateObject("CATIA.Application")
            CATIA.Visible = True
        End If
        ' Declare  ModlePath
        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
    '*********************************************************************************************
    ' Browse For Folder DialogBox to get Folder's Path where store the CATDrawingsDoc
    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 

RE: Multiple CatDrawing to Tif

(OP)
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.

RE: Multiple CatDrawing to Tif

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

RE: Multiple CatDrawing to Tif

(OP)
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

RE: Multiple CatDrawing to Tif

(OP)
up

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Eng-Tips Forums free from inappropriate posts.
The Eng-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Eng-Tips forums is a member-only feature.

Click Here to join Eng-Tips and talk with other members!


Resources


Close Box

Join Eng-Tips® Today!

Join your peers on the Internet's largest technical engineering professional community.
It's easy to join and it's free.

Here's Why Members Love Eng-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close