Hello,
by the friendly help of Dshortway in this forum I got the following code and it works very well with his exporting lines.
But in order to export to different folders I want to run existing external rules.
These three rules do their work, but I don´t know why. I have patched them together from snippets found anywhere in the web.
Certainly they include a lot of unnecessary lines, but they work fine when I start them one by one.
The issue is, that they terminate the loop in the calling rule during the first run-through.
The other problem is, that I am a bloody rooky in programming iLogic and also struggling with English. So I get confused by any code containing more than 5 unknown commands and need your help to fit the other three rules. You find them at the bottom of this page.
Thank you for your patience and good advices.
Best regards
Thomas
Format:HTML Format Version:1.0 StartHTML: 165 EndHTML: 5679 StartFragment: 314 EndFragment: 5647 StartSelection: 314 EndSelection: 314SyntaxEditor Code Snippet
For Each oDrwDoc in ThisApplication.documents
If oDrwDoc.DocumentType=kDrawingDocumentObject Then
oDrwDoc.SaveAs(Replace(oDrwDoc.FullFileName, ".idw", ".pdf"), True)'works, but uses same folder as idw
oDrwDoc.SaveAs(Replace(oDrwDoc.FullFileName, ".idw", ".dwg"), True)'works, but uses same folder as idw
oDrwDoc.SaveAs(Replace(oDrwDoc.FullFileName, ".idw", ".dxf"), True)'works, but uses same folder as idw
' iLogicVb.RunExternalRule("pdf_erstellen")'works just once, then terminates the loop :-(' iLogicVb.RunExternalRule("dwg_erstellen")'works just once, then terminates the loop :-(' iLogicVb.RunExternalRule("dxf_erstellen")'works just once, then terminates the loop :-(
End If
Next
Format:HTML Format Version:1.0 StartHTML: 165 EndHTML: 16520 StartFragment: 314 EndFragment: 16488 StartSelection: 314 EndSelection: 314SyntaxEditor Code Snippet
'pdf_erstellen 'works just once, then terminates the loop :-(
oPath = ThisDoc.Path
oFileName = ThisDoc.FileName(False)'without extension
oRevNum = iProperties.Value("Project", "Revision Number")
oPDFAddIn = ThisApplication.ApplicationAddIns.ItemById("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}")
oDocument = ThisApplication.ActiveDocument
oContext = ThisApplication.TransientObjects.CreateTranslationContext
oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism
oOptions = ThisApplication.TransientObjects.CreateNameValueMap
oDataMedium = ThisApplication.TransientObjects.CreateDataMedium
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")=1
oOptions.Value("Custom_End_Sheet")=1
End If'get PDF target folder path
oFolder=Left(oPath, InStrRev(oPath, "\"))&"PDF"&"\"&ActiveSheet.Size
If Not System.IO.Directory.Exists(oFolder) Then
System.IO.Directory.CreateDirectory(oFolder)'Check for the PDF folder and create it if it does not exist
End If'Set the PDF target file name
oDataMedium.FileName=oFolder&"\"&oFileName&_" Rev"&oRevNum&".pdf"'oDataMedium.FileName = oFolder & "\" & ActiveSheet.Size & "\" & oFileName & " Rev" & oRevNum & ".pdf"
oPDFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)'Publish document
Format:HTML Format Version:1.0 StartHTML: 165 EndHTML: 14115 StartFragment: 314 EndFragment: 14083 StartSelection: 314 EndSelection: 314SyntaxEditor Code Snippet
'dxf_erstellen 'works just once, then terminates the loop :-(
Dim DXFAddIn As TranslatorAddIn'Get the DXF translator Add-In.
DXFAddIn = ThisApplication.ApplicationAddIns.ItemById("{C24E3AC4-122E-11D5-8E91-0010B541CD80}")
Dim oDocument As Document
oDocument=ThisApplication.ActiveDocument
Dim oContext As TranslationContext
oContext = ThisApplication.TransientObjects.Create
TranslationContextoContext.Type=IOMechanismEnum.kFileBrowseIOMechanism
Dim oOptions As NameValueMap' Create a NameValueMap object
oOptions = ThisApplication.TransientObjects.CreateNameValueMap
Dim oDataMedium As DataMedium' Create a DataMedium object
oDataMedium = ThisApplication.TransientObjects.CreateDataMedium
If DXFAddIn.HasSaveCopyAsOptions(oDocument, oContext, oOptions) Then' Check whether the translator has 'SaveCopyAs' options
Dim strIniFile As String
strIniFile="C:\_Thomas\INVENTOR_Projekte\Templates\dxf_acad2007.ini"
oOptions.Value("Export_Acad_IniFile")=strIniFile' Create the name-value that specifies the ini file to use.
EndIf
oPath=ThisDoc.Path
oFolder=Left(oPath, InStrRev(oPath, "\"))&"DXF\"'get target folder path
IfNotSystem.IO.Directory.Exists(oFolder) Then'Check for the DXF folder and create it if it does not exist
System.IO.Directory.CreateDirectory(oFolder)
EndIf
oDataMedium.FileName = oFolder & ThisDoc.FileName & ".acad2007.dxf"'Set the destination file name
DXFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)
Format:HTML Format Version:1.0 StartHTML: 165 EndHTML: 14394 StartFragment: 314 EndFragment: 14362 StartSelection: 314 EndSelection: 314SyntaxEditor Code Snippet
'dwg_erstellen 'works just once, then terminates the loop :-(
Dim DWGAddIn As TranslatorAddIn'Get the DWG translator Add-In.
DWGAddIn = ThisApplication.ApplicationAddIns.ItemById("{C24E3AC4-122E-11D5-8E91-0010B541CD80}")
Dim oDocument As Document
oDocument = ThisApplication.ActiveDocument
Dim oContext As TranslationContext
oContext = ThisApplication.TransientObjects.CreateTranslationContext
oContext.Type=IOMechanismEnum.kFileBrowseIOMechanism
Dim oOptions As NameValueMap' Create a NameValueMap object
oOptions = ThisApplication.TransientObjects.CreateNameValueMap
Dim oDataMedium As DataMedium' Create a DataMedium object
oDataMedium = ThisApplication.TransientObjects.CreateDataMedium
If DWGAddIn.HasSaveCopyAsOptions(oDocument, oContext, oOptions) Then' Check whether the translator has 'SaveCopyAs' options
Dim strIniFile As String
strIniFile = "C:\_Thomas\INVENTOR_Projekte\Templates\dwg_acad2007.ini"
oOptions.Value("Export_Acad_IniFile") = strIniFile' Create the name-value that specifies the ini file to use.
EndIf
oPath=ThisDoc.Path
oFolder=Left(oPath, InStrRev(oPath, "\"))&"DWG\"'get target folder pathIfNotSystem.IO.Directory.Exists(oFolder)Then'Check for the DWG folder and create it if it does not exist
System.IO.Directory.CreateDirectory(oFolder)
End If
oDataMedium.FileName=oFolder&ThisDoc.FileName&".acad2007.dwg"'Set the destination file name
DWGAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)
Solved! Go to Solution.
Solved by rossano_praderi. Go to Solution.
Hi Thomas,
i've read your post and this solution can be the right one.
If you need help or you have any question about this code, send me a message.
Of course, i forget to tell you have to choose which part of code you like to keep.
The second option is more versatile and complete.
Sub Main For Each oDrwDoc in ThisApplication.documents If oDrwDoc.DocumentType=kDrawingDocumentObject Then ' This is a modification of my original code oPath = Replace(oDrwDoc.FullFileName, oDrwDoc.DisplayName, "") ' This is the folder (ends with "\") oName = Replace(Replace(oDrwDoc.FullFileName, ".idw", ""), oPath, "") ' This is the name of the IDW without extension ' Uncomment this code ************************************************ 'CreateFolder(oPath & "pdf") ' This subroutine check/create the folder 'oPdf = oPath & "pdf\" & oName & ".pdf" ' Define the file name 'oDrwDoc.SaveAs(oPdf, True)'works, but uses same folder as idw - Not anymore 'CreateFolder(oPath & "dwg") ' This subroutine check/create the folder 'oDwg = oPath & "dwg\" & oName & ".dwg" ' Define the file name 'oDrwDoc.SaveAs(oDwg, True)'works, but uses same folder as idw - Not anymore 'CreateFolder(oPath & "dxf") ' This subroutine check/create the folder 'oDxf = oPath & "dxf\" & oName & ".dxf" ' Define the file name 'oDrwDoc.SaveAs(oDxf, True)'works, but uses same folder as idw - Not anymore ' ******************************************************************** 'or ' Uncomment this code ************************************************* ' But.... i think this will be you choice <-------------<<<< 'SaveAsPdf(oDrwDoc.FullFileName, oName, oPath, "pdf")'works, but uses same folder as idw - Not anymore 'SaveAsDrw(oDrwDoc.FullFileName, oName, oPath, "dwg")'works, but uses same folder as idw - Not anymore 'SaveAsDrw(oDrwDoc.FullFileName, oName, oPath, "dxf")'works, but uses same folder as idw - Not anymore ' ********************************************************************* End If Next End Sub Sub CreateFolder(nFolder As String) On Error Goto Errore If Not System.IO.Directory.Exists(nFolder) Then System.IO.Directory.CreateDirectory(nFolder) Exit Sub End If Errore: If Err.number <> 0 Then MessageBox.Show(nFolder & vbCr & Err.description, "Error description") End If End Sub Sub RemoveFile(nFile As String) On Error Goto Errore Dim fi As New System.IO.FileInfo(nFile) If Not fi.Exists Then fi.Delete() Exit Sub End If Errore: If Err.number <> 0 Then MessageBox.Show(nFile & vbCr & Err.description, "Error description") End If End Sub Sub SaveAsPdf(oDrwName As String, oFileName As String, oFolder As String, oFormat As String) Dim oDocument As inventor._Document = ThisApplication.documents.itembyname(oDrwName) oPDFAddIn = ThisApplication.ApplicationAddIns.ItemById("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}") oContext = ThisApplication.TransientObjects.CreateTranslationContext oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism oOptions = ThisApplication.TransientObjects.CreateNameValueMap oDataMedium = ThisApplication.TransientObjects.CreateDataMedium oRevNum = "00" 'oRevNum = iProperties.Value(oDrwName, "Project", "Revision Number")' this give you an error, i'm looking for a solution For sSheetNumber = 1 To oDocument.Sheets.Count CreateFolder(oFolder & oFormat) ' This subroutine check/create the folder nFolder = oFolder & oFormat & "\" & oDocument.Sheets.Item(sSheetNumber).Size CreateFolder(nFolder) ' This subroutine check/create the folder 'sSheetName = Left(oDrawing.Sheets.Item(sSheetNumber.tostring).Name, InStr(oDrawing.Sheets.Item(sSheetNumber).Name, ":") -1) ' Sheet name without numbering sSheetName = Replace(oDocument.Sheets.Item(sSheetNumber).Name, ":", "-") ' Sheet name with numbering 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.kPrintSheetRange oOptions.Value("Custom_Begin_Sheet") = sSheetNumber oOptions.Value("Custom_End_Sheet") = sSheetNumber End If oDataMedium.FileName = nFolder & "\" & oFileName & " Rev" & oRevNum & "." & oFormat ' as your requirements 'oDataMedium.FileName = oFolder & oFileName & " Rev" & oRevNum & sSheetName & "." & oFormat ' a possible variation 'RemoveFile(oDataMedium.FileName) ' if you like to remove old versions with the same filename oPDFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium) 'Publish Document Next End Sub Sub SaveAsDrw(oDrwName As String, oFileName As String, oFolder As String, oFormat As String) 'dwg/dxf_erstellen Dim oDocument As inventor._Document = ThisApplication.documents.itembyname(oDrwName) oAddIn = ThisApplication.ApplicationAddIns.ItemById("{C24E3AC4-122E-11D5-8E91-0010B541CD80}") oContext = ThisApplication.TransientObjects.CreateTranslationContext oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism oOptions = ThisApplication.TransientObjects.CreateNameValueMap oDataMedium = ThisApplication.TransientObjects.CreateDataMedium CreateFolder(oFolder & oFormat) ' This subroutine check/create the folder If oAddIn.HasSaveCopyAsOptions(oDocument, oContext, oOptions) Then strIniFile = "C:\_Thomas\INVENTOR_Projekte\Templates\" & oFormat & "_acad2007.ini" oOptions.Value("Export_Acad_IniFile") = strIniFile' Create the name-value that specifies the ini file to use. End If oDataMedium.FileName = oFolder & oFormat & "\" & oFileName & ".acad2007." & oFormat ' Set the destination file name as your requirements 'RemoveFile(oDataMedium.FileName) ' if you like to remove old versions with the same filename oAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium) 'Publish Document End Sub
This is an other link with a simular request (as your information).
Bregs
Rossano Praderi
Hi Thomas,
this is the correction for the revision number.
oRevNum = oDocument.PropertySets.Item(1).Item(7).Value ' Solved If oRevNum = "" Then oRevNum = "00"
Bregs
Rossano Praderi
Hi Rossano,
your code works and I also got the correction line in.
Thank you very much.
Please, don´t be angry for the long time it took until I answer.
One reason is, that I am trying to get a job as a project manager for orders of italian customers.
If that really gets to a fortunate result, I will be glad to invite you for a Pizza 🙂
The other reason for the delay is, that there are still some little issues to solve and I am trying to customize your code for that.
Of course that is hard work for me as a rooky. The code is grown up to a respectable size in my eyes.
So, what I am trying to do:
-The destination folders for all exported files should be one level above. This used to happen by
Format:HTML Format Version:1.0 StartHTML: 165 EndHTML: 2186 StartFragment: 314 EndFragment: 2154 StartSelection: 314 EndSelection: 314SyntaxEditor Code Snippet
Format:HTML Format Version:1.0 StartHTML: 165 EndHTML: 2186 StartFragment: 314 EndFragment: 2154 StartSelection: 314 EndSelection: 314SyntaxEditor Code Snippet
oPath=Left(oPath,Len(oPath)-1)'deletes "\" from the end of the string
oPath=Left(oPath, InStrRev(oPath, "\"))'cuts string to the right "\"
So I put that into the sub main and got my path 🙂
For the pdf-files I need a folder with 4 subfolders: A0, A1, A3, A4 and I used to get them by activeSheet.size
But you use oDocuments.Sheets.Item(asSheetNumber).Size and I get some funny folders like 9994 and so on. ( ? )
Can I use activeSheet.size there or will this collide with other subs ( e.g. the deleting sub ) ?
Another thing I woory about are the ini-files for dwg- and dxf-export. Even if there is no ini-file in the destinated folder, the exports are made and no error occures. Also some statements in these ini-files are redundant to statements in iLogic rules and I wonder, if I really need an ini-file or separate ini-files for each sheet size. Do you know, what they really do?
I started to manipulate your code, but I fear to fail, because I have to prepare for two weeks of trial work at the company I mentioned.
This contains studies about incinerators and other waste processing stuff.
So I put my provisory code in here and hope, that you or someone else gets it a little bit forward 🙂
Thank you very much and best regards
Thomas
Format:HTML Format Version:1.0 StartHTML: 165 EndHTML: 47541 StartFragment: 314 EndFragment: 47509 StartSelection: 314 EndSelection: 314SyntaxEditor Code Snippet
SubMainForEachoDrwDocinThisApplication.documentsIfoDrwDoc.DocumentType=kDrawingDocumentObjectThenoPath=Replace(oDrwDoc.FullFileName, oDrwDoc.DisplayName, "")' This is the folder (ends with "\")oPath=Left(oPath,Len(oPath)-1)'deletes "\" from the end of the stringoPath=Left(oPath, InStrRev(oPath, "\"))'cuts string to the right "\"oName=Replace(Replace(oDrwDoc.FullFileName, ".idw", ""), oPath, "")' This is the name of the IDW without extension' SaveAsPdf(oDrwDoc.FullFileName, oName, oPath, "pdf")' SaveAsDrw(oDrwDoc.FullFileName, oName, oPath, "dwg")' SaveAsDxf(oDrwDoc.FullFileName, oName, oPath, "dxf")EndIfNextEnd SubSubCreateFolder(nFolderAsString)OnErrorGotoErroreIfNotSystem.IO.Directory.Exists(nFolder)ThenSystem.IO.Directory.CreateDirectory(nFolder)Exit SubEndIfErrore: IfErr.number<>0ThenMessageBox.Show(nFolder&vbCr&Err.description, "Error description")EndIfEnd SubSubRemoveFile(nFileAsString)OnErrorGotoErroreDimfiAsNewSystem.IO.FileInfo(nFile)IfNotfi.ExistsThenfi.Delete()Exit SubEndIfErrore: IfErr.number<>0ThenMessageBox.Show(nFile&vbCr&Err.description, "Error description")EndIfEnd SubSubSaveAsPdf(oDrwNameAsString, oFileNameAsString, oFolderAsString, oFormatAsString)'oFolder = oFolder & "\" & oFormat & "\" '& ActiveSheet.SizeDimoDocumentAsinventor._Document=ThisApplication.documents.itembyname(oDrwName)oPDFAddIn=ThisApplication.ApplicationAddIns.ItemById("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}")oContext=ThisApplication.TransientObjects.CreateTranslationContextoContext.Type=IOMechanismEnum.kFileBrowseIOMechanismoOptions=ThisApplication.TransientObjects.CreateNameValueMapoDataMedium=ThisApplication.TransientObjects.CreateDataMediumoRevNum=oDocument.PropertySets.Item(1).Item(7).Value' Solved If oRevNum = "" Then oRevNum = "00"ForsSheetNumber=1TooDocument.Sheets.CountCreateFolder(oFolder&oFormat)' This subroutine check/create the foldernFolder=oFolder&oFormat&"\"&oDocument.Sheets.Item(sSheetNumber).SizeCreateFolder(nFolder)' This subroutine check/create the folderMsgBox(nFolder)'sSheetName = Left(oDrawing.Sheets.Item(sSheetNumber.tostring).Name, InStr(oDrawing.Sheets.Item(sSheetNumber).Name, ":") -1) ' Sheet name without numberingsSheetName=Replace(oDocument.Sheets.Item(sSheetNumber).Name, ":", "-")' Sheet name with numberingIfoPDFAddIn.HasSaveCopyAsOptions(oDataMedium, oContext, oOptions)ThenoOptions.Value("All_Color_AS_Black")=1oOptions.Value("Remove_Line_Weights")=1oOptions.Value("Vector_Resolution")=400oOptions.Value("Sheet_Range")=Inventor.PrintRangeEnum.kPrintSheetRangeoOptions.Value("Custom_Begin_Sheet")=sSheetNumberoOptions.Value("Custom_End_Sheet")=sSheetNumberEndIfoDataMedium.FileName=nFolder&"\"&oFileName&" Rev"&oRevNum&"."&oFormat' as your requirements'oDataMedium.FileName = oFolder & oFileName & " Rev" & oRevNum & sSheetName & "." & oFormat ' a possible variation'RemoveFile(oDataMedium.FileName) ' if you like to remove old versions with the same filenameoPDFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)'Publish DocumentNextEnd SubSubSaveAsDrw(oDrwNameAsString, oFileNameAsString, oFolderAsString, oFormatAsString)'dwg/dxf_erstellenDimoDocumentAsinventor._Document=ThisApplication.documents.itembyname(oDrwName)oAddIn=ThisApplication.ApplicationAddIns.ItemById("{C24E3AC4-122E-11D5-8E91-0010B541CD80}")oContext=ThisApplication.TransientObjects.CreateTranslationContextoContext.Type=IOMechanismEnum.kFileBrowseIOMechanismoOptions=ThisApplication.TransientObjects.CreateNameValueMapoDataMedium=ThisApplication.TransientObjects.CreateDataMediumCreateFolder(oFolder&oFormat)' This subroutine check/create the folderIfoAddIn.HasSaveCopyAsOptions(oDocument, oContext, oOptions)ThenstrIniFile="C:\_Thomas\INVENTOR_Projekte\Templates\"&oFormat&"_acad2007.ini"oOptions.Value("Export_Acad_IniFile")=strIniFile' Create the name-value that specifies the ini file to use. EndIfoDataMedium.FileName=oFolder&oFormat&"\"&oFileName&".acad2007."&oFormat' Set the destination file name as your requirements'RemoveFile(oDataMedium.FileName) ' if you like to remove old versions with the same filenameoAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)'Publish DocumentEnd Sub
Hi Thomas,
@tschuette wrote:Hi Rossano,
your code works and I also got the correction line in.
Thank you very much.
You are welcome!
Please, don´t be angry for the long time it took until I answer.
One reason is, that I am trying to get a job as a project manager for orders of italian customers.
If that really gets to a fortunate result, I will be glad to invite you for a Pizza 🙂
Thank you, I usually work with a company who has their headquarter in Germany (wierd coincidence!)
The other reason for the delay is, that there are still some little issues to solve and I am trying to customize your code for that.
Of course that is hard work for me as a rooky. The code is grown up to a respectable size in my eyes.
So, what I am trying to do:
-The destination folders for all exported files should be one level above. This used to happen by
Format:HTML Format Version:1.0 StartHTML: 165 EndHTML: 2186 StartFragment: 314 EndFragment: 2154 StartSelection: 314 EndSelection: 314SyntaxEditor Code Snippet
Format:HTML Format Version:1.0 StartHTML: 165 EndHTML: 2186 StartFragment: 314 EndFragment: 2154 StartSelection: 314 EndSelection: 314SyntaxEditor Code Snippet
oPath=Left(oPath,Len(oPath)-1)'deletes "\" from the end of the string
oPath=Left(oPath, InStrRev(oPath, "\"))'cuts string to the right "\"So I put that into the sub main and got my path 🙂
For the pdf-files I need a folder with 4 subfolders: A0, A1, A3, A4 and I used to get them by activeSheet.size
But you use oDocuments.Sheets.Item(asSheetNumber).Size and I get some funny folders like 9994 and so on. ( ? )
This is the comments that I have been using in my code
' Inventor.DrawingSheetSizeEnum convertable with sheet size Ex.A4, A2, etc.As you know this Enumerator, in this spesific case, identifies by a number the dimension of the format size.
The utilization of "Select ... case ... End Select" statement is an easy solution for solving this problem.
I will insert the correction of the code in the one I already have posted.
Can I use activeSheet.size there or will this collide with other subs ( e.g. the deleting sub ) ?
I'm considering this Ilogic rule as an external rule, as not embedded in your drawings, you know what i mean.
If you insert "activeSheet.size" this will return the size of the active sheet (what you see) and you will never be able to connect with the hidden sheets underneth.
This is a really basic explanation, but the argument could be more extensive.
By using an embedded rule or an external rule you have to adapt the code.
If you are using an embedded rule you can use the Ilogics statements to get informations about the document where reside your rule.
If you use an external rule (where you control more then one document) you have to access to informations of all the documents you are suppose to work with.
This statement will assign the document by the Application object "Dim oDocument As inventor._Document =
ThisApplication.documents.itembyname(oDrwName)", in this way you got the document control independently by its state(active/inactive).
The follow statement assign the Active document within the Ilogic workspace "oDoc = ThisDoc", the document should be active (same as for the sheets).
Another thing I woory about are the ini-files for dwg- and dxf-export. Even if there is no ini-file in the destinated folder, the exports are made and no error occures. Also some statements in these ini-files are redundant to statements in iLogic rules and I wonder, if I really need an ini-file or separate ini-files for each sheet size. Do you know, what they really do?
You can use the "Select ... Case ... End Select" statement for your file names. as you know, .INI files contain some settings for the file format convertion (Lines type, colors mapping, grouping, dimensions, etc.). If you need help for particulare options, you can ask.
I started to manipulate your code, but I fear to fail, because I have to prepare for two weeks of trial work at the company I mentioned.
This contains studies about incinerators and other waste processing stuff.
So I put my provisory code in here and hope, that you or someone else gets it a little bit forward 🙂
How nice are you 😉 You have posted an unreadable code, please publish a more clear code (which "editor" are you using?).
If you like to have a response to yours question you should publish readable code, otherwise you will have very few responses, you know what i mean.
Thank you very much and best regards
Thomas
Format:HTML Format Version:1.0 StartHTML: 165 EndHTML: 47541 StartFragment: 314 EndFragment: 47509 StartSelection: 314 EndSelection: 314SyntaxEditor Code Snippet
SubMainForEachoDrwDocinThisApplication.documentsIfoDrwDoc.DocumentType=kDrawingDocumentObjectThenoPath=Replace(oDrwDoc.FullFileName, oDrwDoc.DisplayName, "")' This is the folder (ends with "\")oPath=Left(oPath,Len(oPath)-1)'deletes "\" from the end of the stringoPath=Left(oPath, InStrRev(oPath, "\"))'cuts string to the right "\"oName=Replace(Replace(oDrwDoc.FullFileName, ".idw", ""), oPath, "")' This is the name of the IDW without extension' SaveAsPdf(oDrwDoc.FullFileName, oName, oPath, "pdf")' SaveAsDrw(oDrwDoc.FullFileName, oName, oPath, "dwg")' SaveAsDxf(oDrwDoc.FullFileName, oName, oPath, "dxf")EndIfNextEnd SubSubCreateFolder(nFolderAsString)OnErrorGotoErroreIfNotSystem.IO.Directory.Exists(nFolder)ThenSystem.IO.Directory.CreateDirectory(nFolder)Exit SubEndIfErrore: IfErr.number<>0ThenMessageBox.Show(nFolder&vbCr&Err.description, "Error description")EndIfEnd SubSubRemoveFile(nFileAsString)OnErrorGotoErroreDimfiAsNewSystem.IO.FileInfo(nFile)IfNotfi.ExistsThenfi.Delete()Exit SubEndIfErrore: IfErr.number<>0ThenMessageBox.Show(nFile&vbCr&Err.description, "Error description")EndIfEnd SubSubSaveAsPdf(oDrwNameAsString, oFileNameAsString, oFolderAsString, oFormatAsString)'oFolder = oFolder & "\" & oFormat & "\" '& ActiveSheet.SizeDimoDocumentAsinventor._Document=ThisApplication.documents.itembyname(oDrwName)oPDFAddIn=ThisApplication.ApplicationAddIns.ItemById("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}")oContext=ThisApplication.TransientObjects.CreateTranslationContextoContext.Type=IOMechanismEnum.kFileBrowseIOMechanismoOptions=ThisApplication.TransientObjects.CreateNameValueMapoDataMedium=ThisApplication.TransientObjects.CreateDataMediumoRevNum=oDocument.PropertySets.Item(1).Item(7).Value' Solved If oRevNum = "" Then oRevNum = "00"ForsSheetNumber=1TooDocument.Sheets.CountCreateFolder(oFolder&oFormat)' This subroutine check/create the foldernFolder=oFolder&oFormat&"\"&oDocument.Sheets.Item(sSheetNumber).SizeCreateFolder(nFolder)' This subroutine check/create the folderMsgBox(nFolder)'sSheetName = Left(oDrawing.Sheets.Item(sSheetNumber.tostring).Name, InStr(oDrawing.Sheets.Item(sSheetNumber).Name, ":") -1) ' Sheet name without numberingsSheetName=Replace(oDocument.Sheets.Item(sSheetNumber).Name, ":", "-")' Sheet name with numberingIfoPDFAddIn.HasSaveCopyAsOptions(oDataMedium, oContext, oOptions)ThenoOptions.Value("All_Color_AS_Black")=1oOptions.Value("Remove_Line_Weights")=1oOptions.Value("Vector_Resolution")=400oOptions.Value("Sheet_Range")=Inventor.PrintRangeEnum.kPrintSheetRangeoOptions.Value("Custom_Begin_Sheet")=sSheetNumberoOptions.Value("Custom_End_Sheet")=sSheetNumberEndIfoDataMedium.FileName=nFolder&"\"&oFileName&" Rev"&oRevNum&"."&oFormat' as your requirements'oDataMedium.FileName = oFolder & oFileName & " Rev" & oRevNum & sSheetName & "." & oFormat ' a possible variation'RemoveFile(oDataMedium.FileName) ' if you like to remove old versions with the same filenameoPDFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)'Publish DocumentNextEnd SubSubSaveAsDrw(oDrwNameAsString, oFileNameAsString, oFolderAsString, oFormatAsString)'dwg/dxf_erstellenDimoDocumentAsinventor._Document=ThisApplication.documents.itembyname(oDrwName)oAddIn=ThisApplication.ApplicationAddIns.ItemById("{C24E3AC4-122E-11D5-8E91-0010B541CD80}")oContext=ThisApplication.TransientObjects.CreateTranslationContextoContext.Type=IOMechanismEnum.kFileBrowseIOMechanismoOptions=ThisApplication.TransientObjects.CreateNameValueMapoDataMedium=ThisApplication.TransientObjects.CreateDataMediumCreateFolder(oFolder&oFormat)' This subroutine check/create the folderIfoAddIn.HasSaveCopyAsOptions(oDocument, oContext, oOptions)ThenstrIniFile="C:\_Thomas\INVENTOR_Projekte\Templates\"&oFormat&"_acad2007.ini"oOptions.Value("Export_Acad_IniFile")=strIniFile' Create the name-value that specifies the ini file to use. EndIfoDataMedium.FileName=oFolder&oFormat&"\"&oFileName&".acad2007."&oFormat' Set the destination file name as your requirements'RemoveFile(oDataMedium.FileName) ' if you like to remove old versions with the same filenameoAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)'Publish DocumentEnd Sub
May you post your clear code, Thks.
Bregs
Rossano Praderi
Hello Rossano,
sorry, sorry for that bad posting. That happened because I was too tired.
I didn't use a defined editor, just copied ( from the iLogic window ) and pasted ( to the site editor window ).
Somehow these two don´t like each other. I have had this effekt of missing linefeeds and spaces when I fetched your code from here 😐
So I have to fill in these structuring characters manually and hope, not to skip too many of them uncorrected.
Thank you for your patience.
Best regards
Thomas
Sub Main
For Each oDrwDoc in ThisApplication.documents
If oDrwDoc.DocumentType = kDrawingDocumentObject Then
oPath = Replace(oDrwDoc.FullFileName, oDrwDoc.DisplayName, "")' This is the folder (ends with "\")
oPath = Left(oPath,Len(oPath)-1)'deletes "\" from the end of the string
oPath = Left(oPath, InStrRev(oPath, "\"))'cuts string to the right "\"
oName = Replace(Replace(oDrwDoc.FullFileName, ".idw", ""), oPath, "")' This is the name of the IDW without extension
' SaveAsPdf(oDrwDoc.FullFileName, oName, oPath, "pdf")' SaveAsDrw(oDrwDoc.FullFileName, oName, oPath, "dwg")
' SaveAsDxf(oDrwDoc.FullFileName, oName, oPath, "dxf")
End If
Next
End Sub
Sub CreateFolder(nFolderAsString)
On Error Goto Errore
If Not System.IO.Directory.Exists(nFolder) Then
System.IO.Directory.CreateDirectory(nFolder)
Exit Sub
End If
Errore: If Err.number <> 0 Then
MessageBox.Show(nFolder & vbCr & Err.description, "Error description")
End If
End Sub
Sub RemoveFile(nFileAsString)
On Error Goto Errore
Dim fi As NewSystem.IO.FileInfo(nFile)
If Not fi.Exists Then
fi.Delete()
Exit Sub
End If
Errore: If Err.number <> 0 Then
MessageBox.Show(nFile&vbCr&Err.description, "Error description")
End If
End Sub
Sub SaveAsPdf(oDrwNameAsString, oFileNameAsString, oFolderAsString, oFormatAsString)
'oFolder = oFolder & "\" & oFormat & "\" '& ActiveSheet.Size
Dim oDocument As inventor._Document = ThisApplication.documents.itembyname(oDrwName)
oPDFAddIn = ThisApplication.ApplicationAddIns.ItemById("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}")
oContext = ThisApplication.TransientObjects.CreateTranslationContext
oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism
oOptions = ThisApplication.TransientObjects.Create
NameValueMapoDataMedium = ThisApplication.TransientObjects.CreateDataMedium
oRevNum = oDocument.PropertySets.Item(1).Item(7).Value' Solved
If oRevNum = "" Then oRevNum = "00"
For sSheetNumber = 1 To oDocument.Sheets.Count
CreateFolder(oFolder&oFormat)' This subroutine check/create the folder
nFolder = oFolder & oFormat & "\" & oDocument.Sheets.Item(sSheetNumber).SizeCreateFolder(nFolder)' This subroutine check/create the folder
'MsgBox(nFolder)
'sSheetName = Left(oDrawing.Sheets.Item(sSheetNumber.tostring).Name, InStr(oDrawing.Sheets.Item(sSheetNumber).Name, ":") -1) ' Sheet name without numberings
SheetName = Replace(oDocument.Sheets.Item(sSheetNumber).Name, ":", "-")' Sheet name with numbering
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.kPrintSheetRange
oOptions.Value("Custom_Begin_Sheet") = sSheetNumber
oOptions.Value("Custom_End_Sheet") = sSheetNumber
EndIf
oDataMedium.FileName = nFolder &"\" & oFileName & " Rev" & oRevNum & "." & oFormat' as your requirements
'oDataMedium.FileName = oFolder & oFileName & " Rev" & oRevNum & sSheetName & "." & oFormat ' a possible variation
'RemoveFile(oDataMedium.FileName) ' if you like to remove old versions with the same filename
oPDFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)'Publish Document
Next
End Sub
Sub SaveAsDrw(oDrwNameAsString, oFileNameAsString, oFolderAsString, oFormatAsString)'dwg/dxf_erstellen
Dim oDocument As inventor._Document=ThisApplication.documents.itembyname(oDrwName)
oAddIn=ThisApplication.ApplicationAddIns.ItemById("{C24E3AC4-122E-11D5-8E91-0010B541CD80}")
oContext = ThisApplication.TransientObjects.CreateTranslationContext
oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism
oOptions = ThisApplication.TransientObjects.CreateNameValueMap
oDataMedium = ThisApplication.TransientObjects.CreateDataMediumCreateFolder(oFolder&oFormat)' This subroutine check/create the folder
If oAddIn.HasSaveCopyAsOptions(oDocument, oContext, oOptions) Then
strIniFile="C:\_Thomas\INVENTOR_Projekte\Templates\"&oFormat&"_acad2007.ini"
oOptions.Value("Export_Acad_IniFile") = strIniFile' Create the name-value that specifies the ini file to use.
End If
oDataMedium.FileName=oFolder&oFormat&"\"&oFileName&".acad2007."&oFormat' Set the destination file name as your requirements
'RemoveFile(oDataMedium.FileName) ' if you like to remove old versions with the same filename
oAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)'Publish
Hi Thomas,
i've added the "Select Case" constructor as example to convert the "DrawingSheetSizeEnum Enumerator" into readable sheet sizes.
If you have any question, I'm there.
Sub SaveAsPdf(oDrwName As String, oFileName As String, oFolder As String, oFormat As String) 'oFolder = oFolder & "\" & oFormat & "\" '& ActiveSheet.Size Dim oDocument As inventor._Document = ThisApplication.documents.itembyname(oDrwName) oPDFAddIn = ThisApplication.ApplicationAddIns.ItemById("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}") oContext = ThisApplication.TransientObjects.CreateTranslationContext oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism oOptions = ThisApplication.TransientObjects.Create NameValueMapoDataMedium = ThisApplication.TransientObjects.CreateDataMedium oRevNum = oDocument.PropertySets.Item(1).Item(7).Value' Solved If oRevNum = "" Then oRevNum = "00" For sSheetNumber = 1 To oDocument.Sheets.Count CreateFolder(oFolder & oFormat)' This subroutine check/create the folder ' you find these informations in the develolpers guide of Inventor (?) ' kA0DrawingSheetSize 9993 A0 size (typically For metric units). ' kA1DrawingSheetSize 9994 A1 size (typically For metric units). ' kA2DrawingSheetSize 9995 A2 size (typically For metric units). ' kA3DrawingSheetSize 9996 A3 size (typically For metric units). Select Case oDocument.Sheets.Item(sSheetNumber).Size Case 9993 oSize = "A0" Case 994 oSize = "A1" Case 995 oSize = "A2" Case 996 oSize = "A3" Case Else oSize = "OutSize" End Select nFolder = oFolder & oFormat & "\" & oSize CreateFolder(nFolder)' This subroutine check/create the folder 'MsgBox(nFolder) 'sSheetName = Left(oDrawing.Sheets.Item(sSheetNumber.tostring).Name, InStr(oDrawing.Sheets.Item(sSheetNumber).Name, ":") -1) ' Sheet name without numberings SheetName = Replace(oDocument.Sheets.Item(sSheetNumber).Name, ":", "-")' Sheet name with numbering 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.kPrintSheetRange oOptions.Value("Custom_Begin_Sheet") = sSheetNumber oOptions.Value("Custom_End_Sheet") = sSheetNumber End If oDataMedium.FileName = nFolder & "\" & oFileName & " Rev" & oRevNum & "." & oFormat' as your requirements 'oDataMedium.FileName = oFolder & oFileName & " Rev" & oRevNum & sSheetName & "." & oFormat ' a possible variation 'RemoveFile(oDataMedium.FileName) ' if you like to remove old versions with the same filename oPDFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)'Publish Document Next End Sub Sub SaveAsDrw(oDrwNameAsString, oFileNameAsString, oFolderAsString, oFormatAsString)'dwg/dxf_erstellen Dim oDocument As inventor._Document=ThisApplication.documents.itembyname(oDrwName) oAddIn=ThisApplication.ApplicationAddIns.ItemById("{C24E3AC4-122E-11D5-8E91-0010B541CD80}") oContext = ThisApplication.TransientObjects.CreateTranslationContext oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism oOptions = ThisApplication.TransientObjects.CreateNameValueMap oDataMedium = ThisApplication.TransientObjects.CreateDataMediumCreateFolder(oFolder & oFormat)' This subroutine check/create the folder If oAddIn.HasSaveCopyAsOptions(oDocument, oContext, oOptions) Then ' if you like to include the format size (A0, A1, etc) check within the SaveAsPdf() subroutine strIniFile="C:\_Thomas\INVENTOR_Projekte\Templates\" & oFormat & "_acad2007.ini" oOptions.Value("Export_Acad_IniFile") = strIniFile' Create the name-value that specifies the ini file to use. End If oDataMedium.FileName=oFolder & oFormat & "\" & oFileName & ".acad2007." & oFormat' Set the destination file name as your requirements 'RemoveFile(oDataMedium.FileName) ' if you like to remove old versions with the same filename oAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)'Publish End Sub
Ps: By posting your code, please use this botton you will find it on the menu bar, this should preserve the code formatting.
Bregs
Rossano Praderi
Hello Rossano,
I thank you very much for your programming. Now it is running best 🙂
Also your hint about the c-button is very useful. I should have known earlier ...
Now I can study with the details of your code while waiting for the companies call.
( They announced to tell me the beginning of the test-working at the beginning of this week. )
Maybe there will arouse some more questions 😉
Have a nice day
Thomas
Can't find what you're looking for? Ask the community or share your knowledge.