Raul Berame
Automotive
- Jan 12, 2023
- 11
Hello I am using macro from this thread for exporting PDF files from CATIA Drawing. Is it possible to modify code to automatically convert multiple sheets into 1 file?
Here's the code I used from this Fourum:
Sub CATMain()
'Retrive the active document
Dim Doc As Document
Set Doc = CATIA.ActiveDocument
'Test the document's type, if it is not a drawing document the macro stops
If TypeName(Doc) = "DrawingDocument" Then
Dim DocDocument As DrawingDocument
Set DocDocument = Doc
Else
MsgBox "This macro can be run with a drawing document only."
Exit Sub
End If
Const WINDOW_HANDLE = 0
Const NO_OPTIONS = 0
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder _
(WINDOW_HANDLE, "Select a folder:", NO_OPTIONS, "C:\Scripts")
Set objFolderItem = objFolder.Self
objPath = objFolderItem.Path
MsgBox objPath
Set objFolderItem = CreateObject("Scripting.FileSystemObject")
Dim ShortPartNo, strFolderPath
ShortPartNo = Left(Doc.Name, 8)
MsgBox ShortPartNo
strFolderPath = objPath &"\"& ShortPartNo & "\"
MsgBox strFolderPath
If Not objFolderItem.FolderExists(strFolderPath) Then
objFolderItem.CreateFolder(strFolderPath)
End If
Doc.ExportData strFolderPath & ShortPartNo& ".pdf", "pdf"
CATIA.DisplayFileAlerts = False
End Sub
Here's the code I used from this Fourum:
Sub CATMain()
'Retrive the active document
Dim Doc As Document
Set Doc = CATIA.ActiveDocument
'Test the document's type, if it is not a drawing document the macro stops
If TypeName(Doc) = "DrawingDocument" Then
Dim DocDocument As DrawingDocument
Set DocDocument = Doc
Else
MsgBox "This macro can be run with a drawing document only."
Exit Sub
End If
Const WINDOW_HANDLE = 0
Const NO_OPTIONS = 0
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder _
(WINDOW_HANDLE, "Select a folder:", NO_OPTIONS, "C:\Scripts")
Set objFolderItem = objFolder.Self
objPath = objFolderItem.Path
MsgBox objPath
Set objFolderItem = CreateObject("Scripting.FileSystemObject")
Dim ShortPartNo, strFolderPath
ShortPartNo = Left(Doc.Name, 8)
MsgBox ShortPartNo
strFolderPath = objPath &"\"& ShortPartNo & "\"
MsgBox strFolderPath
If Not objFolderItem.FolderExists(strFolderPath) Then
objFolderItem.CreateFolder(strFolderPath)
End If
Doc.ExportData strFolderPath & ShortPartNo& ".pdf", "pdf"
CATIA.DisplayFileAlerts = False
End Sub