convert inventor drgs to pdf files

[Anonymous]

Hi all,

I need a macro to convert  all the inventor drgs in the specifed folder to pdf files and saved in the same folder.

yes. i know that there is save copy as option to convert each file into pdf one by one. but is it possible to create pdf for all drgs in a single click i.e easy way when compared to the above one.

Hope someone will help...

thanks

[Anonymous]

Hi all,

I need a macro to convert  all the inventor drgs in the specifed folder to pdf files and saved in the same folder.

yes. i know that there is save copy as option to convert each file into pdf one by one. but is it possible to create pdf for all drgs in a single click i.e easy way when compared to the above one.

Hope someone will help...

thanks

[brendan.henderson]

I'm sure there is code available to do what you want, but you could use Task Scheduler to run a Print Files task to a PDF printer to do this.

[Anonymous]

Yes. But unfortunately I haven't have administrative rights to create the task in the task scheduler.

Regards,
rishbi



#####################################################################################

This message and any attachments are solely for the use of the intended recipients. They may contain privileged and/or confidential information or other information protected from disclosure. If you are not an intended recipient, you are hereby notified that you received this email in error and that any review, dissemination, distribution or copying of this email and any attachment is strictly prohibited. If you have received this email in error, please contact the sender and delete the message and any attachment from your system.

Thank You.

#####################################################################################

[rossano_praderi]

Hi,

with this macro you have to choice a folder and all the idw inside that folder will be saved as pdf (this macro open each file before save them).

Sub FilesToPdf()
  Dim oDoc As DrawingDocument
  Dim aPath, FileName As String
  Dim FSO, FSO_FOLDER, FSO_FILE As Object
  
  aPath = SelFolder
  If aPath <> "" Then
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set FSO_FOLDER = FSO.GetFolder(aPath & "\")
    If FSO_FOLDER.Files.Count > 0 Then
      For Each FSO_FILE In FSO_FOLDER.Files
        If FSO.GetExtensionName(FSO_FILE) = "idw" Then
            Set oDoc = ThisApplication.Documents.Open(FSO_FILE)
            Call oDoc.SaveAs(Replace(FSO_FILE, ".idw", ".pdf"), True)
            oDoc.Close (False)
        End If
      Next
    Else
      MsgBox "No Files Found at " & aPath
    End If
    Set FSO = Nothing
    Set FSO_FOLDER = Nothing
End If
End Sub


Private Function SelFolder() As String
  Dim folderDialog As FileDialog
  Dim ShellApp, result
  Set ShellApp = CreateObject("Shell.Application").BrowseForFolder(0, "Please choose a folder", 1, _
                              ThisApplication.FileLocations.Workspace)
  SelFolder = ""
  If (ShellApp.items.Item.Path <> "") Then
    SelFolder = ShellApp.items.Item.Path
  End If
End Function

Bregs

Rossano Praderi

[Anonymous]

Hi Dshortway,

thanks for spending your valuable time.

this macro gives the right result but output pdf file is not in black color. while converting pdf , we set the property "All color as black" as true. i think this one is missing in the macro. could you please update the macro to get the desired result. 

regards

rishbi

[wood.isbell]

You should be able to throw this in up top:

oPDFAddIn = ThisApplication.ApplicationAddIns.ItemById("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}")
oContext = ThisApplication.TransientObjects.CreateTranslationContext
oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism
oOptions = ThisApplication.TransientObjects.CreateNameValueMap
If oPDFAddIn.HasSaveCopyAsOptions(oDataMedium, oContext, oOptions) Then
	oOptions.Value("All_Color_AS_Black") = 1
	oOptions.Value("Remove_Line_Weights") = 1
	oOptions.Value("Vector_Resolution") = 400
	oOptions.Value("Sheet_Range") = Inventor.PrintRangeEnum.kPrintAllSheets
	'oOptions.Value("Custom_Begin_Sheet") = 2
	'oOptions.Value("Custom_End_Sheet") = 4
End If
oDataMedium = ThisApplication.TransientObjects.CreateDataMedium

Make sure you actually want those options.

Then swap your SaveAs for:

oPDFAddIn.SaveCopyAs(oDoc, oContext, oOptions, oDataMedium)

[rossano_praderi]

Hi Rishbi,

i would like to give you an other example of code that include the "options" suggested by Wisbell.

http://forums.autodesk.com/t5/inventor-general-discussion/ilogic-rules-work-when-run-separately-not-...

Bregs

Rossano Praderi

[rossano_praderi · Accepted solution]

and ... as your request... this is my updated macro...

Sub FilesToPdf()
  Dim oDoc As DrawingDocument
  Dim aPath, FileName As String
  Dim FSO, FSO_FOLDER, FSO_FILE As Object
  
  aPath = SelFolder
  If aPath <> "" Then
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set FSO_FOLDER = FSO.GetFolder(aPath & "\")
    If FSO_FOLDER.Files.Count > 0 Then
      For Each FSO_FILE In FSO_FOLDER.Files
        If FSO.GetExtensionName(FSO_FILE) = "idw" Then
            Set oDoc = ThisApplication.Documents.Open(FSO_FILE)
            Call SaveAsPdf(oDoc, Replace(FSO_FILE, ".idw", ".pdf"))
            'Call oDoc.SaveAs(Replace(FSO_FILE, ".idw", ".pdf"), True)
            oDoc.Close (True)
        End If
      Next
    Else
      MsgBox "No Files Found at " & aPath
    End If
    Set FSO = Nothing
    Set FSO_FOLDER = Nothing
End If
End Sub

Sub SaveAsPdf(oDocument As Inventor.Document, oFileName As String)
  Dim oOptions, oContext, oPDFAddIn, NameValueMapoDataMedium, oDataMedium
  Set oPDFAddIn = ThisApplication.ApplicationAddIns.ItemById("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}")
  Set oContext = ThisApplication.TransientObjects.CreateTranslationContext
  oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism
  Set oOptions = ThisApplication.TransientObjects.CreateNameValueMap
  Set oDataMedium = ThisApplication.TransientObjects.CreateDataMedium
  oDataMedium.FileName = oFileName
    If oPDFAddIn.HasSaveCopyAsOptions(oDataMedium, oContext, oOptions) Then
      oOptions.Value("All_Color_AS_Black") = 0  ' set to 0 for colors
      'oOptions.Value("All_Color_AS_Black") = 1 ' set to 1 for black/white
      oOptions.Value("Remove_Line_Weights") = 1
      oOptions.Value("Vector_Resolution") = 400
      oOptions.Value("Sheet_Range") = Inventor.PrintRangeEnum.kPrintSheetRange
      oOptions.Value("Custom_Begin_Sheet") = 1
      oOptions.Value("Custom_End_Sheet") = oDocument.Sheets.Count
    End If
    Call oPDFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium) 'Publish Document
End Sub

Private Function SelFolder() As String
  Dim folderDialog As FileDialog
  Dim ShellApp, result
  Set ShellApp = CreateObject("Shell.Application").BrowseForFolder(0, "Please choose a folder", 1, _
                              ThisApplication.FileLocations.Workspace)
  SelFolder = ""
  If (ShellApp.items.Item.Path <> "") Then
    SelFolder = ShellApp.items.Item.Path
  End If
End Function

Bregs

Rossano Praderi

[Anonymous]

Dear members

This is exactly what i was looking for!

Thanks  to

Mr.Rossano Praderi

Mr.Wisbell

regards

gobi