Making dwg & pdf from multiple drawings

Making dwg & pdf from multiple drawings

dypro
Advocate Advocate
608 Views
7 Replies
Message 1 of 8

Making dwg & pdf from multiple drawings

dypro
Advocate
Advocate

Hello everyone, I have taken some code from these forums and modified it to my needs, but for some reason I don't get, it does work when I use it into one file, but it doesn't work well when I use it in several ("all opened drawings")
It should make the dwg if you chose to, and when going to make the pdfs, determine whether or not each drawing is a multipage or not, and if it is, give you the chance to make a pdf of all the pages, or make a pdf of each page.
Not sure why, when I try it with several drawings, (for example, two with two pages and one with only a page) the outcome is diferent depending on the file I start in, and the dwgs and pdfs are with diferent names, but same content.
I hope you can help me figure out what is wrong with my code.

 

 

Sub Main()
	Dim myDate As String = Now().ToString("yyyy-MM-dd")
 	myDate = myDate.Replace(":","")  ' & " - " & TypeString
	userChoice = InputRadioBox("Elije el alcance", "Este dibujo", "Todos los dibujos abiertos", True, Title := "Elije el alcance")
		
 	UserSelectedActionList = New String(){"DWG & PDF", "Solo PDF", "Solo DWG"}
  		UserSelectedAction = InputListBox("¿Que quieres hacer?", _
        UserSelectedActionList, UserSelectedActionList(0), Title := "Archivos a realizar", ListName := "Opciones")
      	Select UserSelectedAction
   			Case "DWG & PDF": UserSelectedAction = 3
   			Case "Solo PDF":  UserSelectedAction = 1
   			Case "Solo DWG":  UserSelectedAction = 2
   		End Select
   
 	If userChoice Then
   		Call MakePDFFromDoc(ThisApplication.ActiveDocument, myDate, UserSelectedAction)
  	Else
   	For Each oDoc In ThisApplication.Documents
    	If oDoc.DocumentType = kDrawingDocumentObject
     		Try
      			If Len(oDoc.File.FullFileName)>0 Then
       			Call MakePDFFromDoc(oDoc, myDate, UserSelectedAction)
      			End If
     		Catch
     		End Try
    	End If
   	Next
  	End If
	
 End Sub
 
 
 Sub MakePDFFromDoc(ByRef oDocument As Document, DateString As String, UserSelectedAction As Integer)
 
	If (UserSelectedAction = 1) Then
			Dim xSheet As Sheet = ActiveSheet.Sheet
			Dim xDoc As DrawingDocument = xSheet.Parent
			'Convert to list to use IndexOf
			'List index starts at 0 while indexes of oDoc.Sheets starts at 1, thats why I add +1
			Dim xIndex As Integer = xDoc.Sheets.OfType(Of Sheet).ToList().IndexOf(xSheet) + 1
			'Check to see that we got the correct sheet
			
			If xDoc.Sheets(xIndex).Name = "Sheet:1" Then
				GoTo multi
			Else
			End If
		go = MsgBox("¿Hacer pdf multipagina?" & vbCrLf & ThisDoc.FileName(False) , MessageBoxButtons.YesNo, "PDF")
		If go = vbYes Then
			multi :
				  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
				  oFullFileName = oDocument.File.FullFileName
				  oPath = Left(oFullFileName, InStrRev(oFullFileName, "\")-1)
				  oFileName = Right(oFullFileName, Len(oFullFileName)-InStrRev(oFullFileName, "\"))
				  oFilePart = Left(oFileName, InStrRev(oFileName, ".")-1)
				  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
				  oFolder = oPath & "\PDFs"
				  If Not System.IO.Directory.Exists(oFolder) Then
				   System.IO.Directory.CreateDirectory(oFolder)
				  End If
				  oDataMedium.FileName = oFolder & "\" & oFilePart & ".pdf"
				  oPDFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)'For PDF's
				  
			  GoTo final
		  Else
			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
		 	oFullFileName = oDocument.File.FullFileName
		  	oPath = Left(oFullFileName, InStrRev(oFullFileName, "\")-1)
		  	oFileName = Right(oFullFileName, Len(oFullFileName) -InStrRev(oFullFileName, "\"))
			oFilePart = Left(oFileName, InStrRev(oFileName, ".") -1)
			oFilename2 = Left(oFileName, Len(oFileName)-4)
			oDocument = ThisApplication.ActiveDocument
			Dim oDrawing As DrawingDocument
			oDrawing = ThisDoc.Document
			Dim oSheet As Sheet
			Dim lPos As Long
			Dim rPos As Long
			Dim sLen As Long
			Dim sSheetName As String
			Dim iSheetNumber As Integer
				For Each oSheet In oDrawing.Sheets
						lPos = InStr(oSheet.Name, ":")
						sLen = Len(oSheet.Name)
						sSheetName = Left(oSheet.Name, lPos -1)
						iSheetNumber = Right(oSheet.Name, sLen -lPos)
						oOptions.Value("All_Color_AS_Black") = 1
						oOptions.Value("Remove_Line_Weights") = 1
						oOptions.Value("Vector_Resolution") = 400
						oOptions.Value("Sheet_Range") = Inventor.PrintRangeEnum.kPrintCurrentSheet 
					oFolder = oPath & "\PDFs"
					  If Not System.IO.Directory.Exists(oFolder) Then
					  System.IO.Directory.CreateDirectory(oFolder)
					  End If
					  oDataMedium.FileName = oFolder & "\" & oFilename2 & " " & sSheetName & " " & iSheetNumber  & ".pdf"
					  oSheet.Activate
					  oPDFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)'For PDF's
					  
				 Next
			  GoTo final
		End If
	Else If (UserSelectedAction = 2) Then
			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
		 	oFullFileName = oDocument.File.FullFileName
		  	oPath = Left(oFullFileName, InStrRev(oFullFileName, "\")-1)
		  	oFileName = Right(oFullFileName, Len(oFullFileName)-InStrRev(oFullFileName, "\"))
		  	oFilePart = Left(oFileName, InStrRev(oFileName, ".")-1)
			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
			oFolder = oPath & "\DWGs"
			  If Not System.IO.Directory.Exists(oFolder) Then
			  System.IO.Directory.CreateDirectory(oFolder)
			  End If
			  oDocument.SaveAs(oFolder & "\" & oFilePart & ".dwg", True) 'For DWG's
			GoTo final
	 Else If (UserSelectedAction = 3) Then
		 	Dim xSheet As Sheet = ActiveSheet.Sheet
			Dim xDoc As DrawingDocument = xSheet.Parent
			'Convert to list to use IndexOf
			'List index starts at 0 while indexes of oDoc.Sheets starts at 1, thats why I add +1
			Dim xIndex As Integer = xDoc.Sheets.OfType(Of Sheet).ToList().IndexOf(xSheet) + 1
			'Check to see that we got the correct sheet
			If xDoc.Sheets(xIndex).Name = "Sheet:1" Then
				GoTo multip
				Else
			End If
		 go = MsgBox("¿Hacer pdf multipagina?" & vbCrLf & ThisDoc.FileName(False) , MessageBoxButtons.YesNo, "PDF")
		If go = vbYes Then
			multip:
				  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
				 oFullFileName = oDocument.File.FullFileName
				  oPath = Left(oFullFileName, InStrRev(oFullFileName, "\")-1)
				  oFileName = Right(oFullFileName, Len(oFullFileName)-InStrRev(oFullFileName, "\"))
				  oFilePart = Left(oFileName, InStrRev(oFileName, ".")-1)
				  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
				  oFolder = oPath & "\PDFs"
				  If Not System.IO.Directory.Exists(oFolder) Then
				   System.IO.Directory.CreateDirectory(oFolder)
				  End If
				  oDataMedium.FileName = oFolder & "\" & oFilePart & ".pdf"
				 oPDFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)'For PDF's
				 
			  GoTo dwgs
		  Else
			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
		 	oFullFileName = oDocument.File.FullFileName
		  	oPath = Left(oFullFileName, InStrRev(oFullFileName, "\")-1)
		  	oFileName = Right(oFullFileName, Len(oFullFileName) -InStrRev(oFullFileName, "\"))
			oFilePart = Left(oFileName, InStrRev(oFileName, ".") -1)
			oFilename2 = Left(oFileName, Len(oFileName)-4)
			oDocument = ThisApplication.ActiveDocument
			Dim oDrawing As DrawingDocument
			oDrawing = ThisDoc.Document
			Dim oSheet As Sheet
			Dim lPos As Long
			Dim rPos As Long
			Dim sLen As Long
			Dim sSheetName As String
			Dim iSheetNumber As Integer
				For Each oSheet In oDrawing.Sheets
						lPos = InStr(oSheet.Name, ":")
						sLen = Len(oSheet.Name)
						sSheetName = Left(oSheet.Name, lPos -1)
						iSheetNumber = Right(oSheet.Name, sLen -lPos)
						oOptions.Value("All_Color_AS_Black") = 1
						oOptions.Value("Remove_Line_Weights") = 1
						oOptions.Value("Vector_Resolution") = 400
						oOptions.Value("Sheet_Range") = Inventor.PrintRangeEnum.kPrintCurrentSheet 
					oFolder = oPath & "\PDFs"
					  If Not System.IO.Directory.Exists(oFolder) Then
					  System.IO.Directory.CreateDirectory(oFolder)
					  End If
					  oDataMedium.FileName = oFolder & "\" & oFilename2 & " " & sSheetName & " " & iSheetNumber  & ".pdf"
					  oSheet.Activate
					  oPDFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)'For PDF's
					  
				 Next
			GoTo dwgs
		 dwgs :
		 	oFolder = oPath & "\DWGs"
			  If Not System.IO.Directory.Exists(oFolder) Then
			  System.IO.Directory.CreateDirectory(oFolder)
			  End If
			  If (UserSelectedAction = 3) Then
			  oDocument.SaveAs(oFolder & "\" & oFilePart & ".dwg", True) 'For DWG's
			  End If
		  End If	  
	End If
	
	  	final :
 End Sub

 

 

 

0 Likes
Accepted solutions (2)
609 Views
7 Replies
Replies (7)
Message 2 of 8

WCrihfield
Mentor
Mentor

Hi @dypro.  That is a long code, but while quickly scrolling down through it, the first thing I found that could cause problems is this following line of code, just a couple lines into your custom sub routine:

 

Dim xSheet As Sheet = ActiveSheet.Sheet

 

That line is using an iLogic shortcut snippet, and could very easily not be pointing to the correct document.  This line should be using the oDocument variable passed to that sub routine from the main routine, instead of using a shortcut snippet like that.  If that 'ActiveSheet' term is used in an internal iLogic rule, it will always point to the document that the rule is saved within, and if used in an external iLogic rule, it might point to whichever document was 'active' when the rule first started, which would not work if looping through multiple open documents.

Wesley Crihfield

EESignature

(Not an Autodesk Employee)

0 Likes
Message 3 of 8

WCrihfield
Mentor
Mentor

Then further down I am seeing more document references being created, for seemingly no reason, which is almost always a bad idea.  For instance this following code is repeated in two different places after that point in the sub routine:

 

oDocument = ThisApplication.ActiveDocument
Dim oDrawing As DrawingDocument
oDrawing = ThisDoc.Document

 

If the document object was passed to the sub routine with the oDocument variable (or your xDoc variable, which has more specifically been declared as a DrawingDocument, instead of just a generic Document), you should continue to use that document reference throughout the entire sub routine, instead of redefining which document you are targeting multiple times.  Multiple document references through out one code, and/or using incorrect document references in code is one of the main problems I see over and over again here on the forums, because they usually lead to multiple kinds of problems.

 

Edit:  That 'ThisDoc' reference is another one that will usually point to the document that the internal rule is saved within, or to the originally active document in an external rule, so you may want to avoid using that reference down in your sub routine too.

Wesley Crihfield

EESignature

(Not an Autodesk Employee)

0 Likes
Message 4 of 8

dypro
Advocate
Advocate

Hello, thanks for the answer,
first of all, I learned about ilogic like a month ago, and I'm trying to learn to code a litle in it, so I apreciate every comments regarding good practise.
With that in mind, the code was made by copy pasteing various codes in these forums and other pages an "remixing" it to fill my purposes.
Honestly I don't fully understand what you are explaining but I get that declaring multiple times over the same thing is not a good idea.... 
On the code side, I supose that the main problem is in the "change file" or "change sheet" lines, but im not sure. 

0 Likes
Message 5 of 8

Andrii_Humeniuk
Advisor
Advisor
Accepted solution

I almost completely rewrote your rule. Please check if everything works as you wanted.

Sub Main
	userChoice = InputRadioBox("Elije el alcance", "Este dibujo", "Todos los dibujos abiertos", True, Title := "Elije el alcance")		
	Dim UserSelectedActionList As New List(Of String) From {"DWG & PDF", "Solo PDF", "Solo DWG" }
	UserSelectedAction = InputListBox("¿Que quieres hacer?", _
	UserSelectedActionList, UserSelectedActionList(0), Title := "Archivos a realizar", ListName := "Opciones")
	Dim iSelected As Long
	Select UserSelectedAction
	Case "DWG & PDF": iSelected = 3
	Case "Solo PDF":  iSelected = 1
	Case "Solo DWG":  iSelected = 2
	End Select
	If userChoice Then
		Call MakePDFFromDoc(ThisApplication.ActiveDocument, iSelected)
	Else
	   	For Each oDoc As Document In ThisApplication.Documents
	    	If TypeOf oDoc Is DrawingDocument Then				
      			If System.IO.File.Exists(oDoc.File.FullFileName) Then
	       			Call MakePDFFromDoc(oDoc, iSelected)
      			End If
	    	End If
	   	Next
	End If	
End Sub
 
 
Private Sub MakePDFFromDoc(ByVal oDocument As DrawingDocument, ByVal iSelected As Long)
	Dim oSheets As Sheets = oDocument.Sheets
	Dim oPDFAddIn As ApplicationAddIn = ThisApplication.ApplicationAddIns.ItemById("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}")
	Dim oContext As TranslationContext = ThisApplication.TransientObjects.CreateTranslationContext
	oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism
	Dim oOptions As NameValueMap = ThisApplication.TransientObjects.CreateNameValueMap
	oOptions.Value("All_Color_AS_Black") = 1
	oOptions.Value("Remove_Line_Weights") = 1
	oOptions.Value("Vector_Resolution") = 400
	oOptions.Value("Sheet_Range") = Inventor.PrintRangeEnum.kPrintCurrentSheet
	Dim oDataMedium As DataMedium = ThisApplication.TransientObjects.CreateDataMedium
	Dim oFullFileName As String = oDocument.File.FullFileName
	Dim oPath As String = System.IO.Path.GetDirectoryName(oFullFileName)
	Dim oFilePart As String = System.IO.Path.GetFileNameWithoutExtension(oFullFileName)
	Dim oFolderPDF As String = oPath & "\PDFs"
	Dim	oFolderDWG As String = oPath & "\DWGs"
	If iSelected = 1 Or iSelected = 3 Then
		If Not System.IO.Directory.Exists(oFolderPDF) Then
			System.IO.Directory.CreateDirectory(oFolderPDF)
		End If
		If oSheets.Count <= 1 Then
			oDataMedium.FileName = oFolderPDF & "\" & oFilePart & ".pdf"
			If Not System.IO.Directory.Exists(oDataMedium.FileName) Then
				oPDFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)'For PDF's
			End If
		Else
			go = MsgBox("¿Hacer pdf multipagina?" & vbCrLf & oFilePart, MessageBoxButtons.YesNo, "PDF")
			If go = vbYes Then
				oOptions.Value("Sheet_Range") = Inventor.PrintRangeEnum.kPrintAllSheets
				oDataMedium.FileName = oFolderPDF & "\" & oFilePart & ".pdf"
				oPDFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)'For PDF's
			Else
				Dim lPos, rPos, sLen As Long
				Dim sSheetName As String
				Dim iSheetNumber As Integer
				For Each oSheet As Sheet In oDocument.Sheets
					lPos = InStr(oSheet.Name, ":")
					sLen = Len(oSheet.Name)
					sSheetName = Left(oSheet.Name, lPos -1)
					iSheetNumber = Right(oSheet.Name, sLen -lPos)
					oDataMedium.FileName = oFolderPDF & "\" & oFilename2 & " " & sSheetName & " " & iSheetNumber  & ".pdf"
					If Not System.IO.Directory.Exists(oDataMedium.FileName) Then
						oSheet.Activate()
						oPDFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)'For PDF's	
					End If
				Next
			End If
		End If
	End If
	If iSelected = 2 Or iSelected = 3 Then
		If Not System.IO.Directory.Exists(oFolderDWG) Then
			System.IO.Directory.CreateDirectory(oFolderDWG)
		End If
		If Not System.IO.Directory.Exists(oFolderDWG & "\" & oFilePart & ".dwg") Then
			oDocument.SaveAs(oFolderDWG & "\" & oFilePart & ".dwg", True) 'For DWG's
		End If
	End If
End Sub

 

 

Andrii Humeniuk - CAD Coordinator, Autodesk Certified Instructor

LinkedIn | My free Inventor Addin | My Repositories

Did you find this reply helpful ? If so please use the Accept as Solution/Like.

EESignature

Message 6 of 8

dypro
Advocate
Advocate

Hello again @Andrii_Humeniuk , something is not working properly.

 

Right now I have 3 open drawings, and it seems to have done the task well, but I chose one to be multipage and 2 of them to be "non multipage, but the names of the two "non multipage" drawings, have become only the "Sheet 1" and "Sheet 2", thus when converting several, the second drawing has overwritten the first one.

The outcome was this:

dypro_1-1684737321240.png

 

 

Here I chose two multipage, and one, non multipage, and the outcome was

dypro_0-1684737237014.png

It seems to be just a matter of the name in the non multipage drawings.

It should be whateverthenameofthedrawing-whateverthenameofthesheet.pdf so they don't overwrite each other

0 Likes
Message 7 of 8

Andrii_Humeniuk
Advisor
Advisor

Please specify how your files should be named, depending on the type of file you are exporting (single-page, multi-page).

Andrii Humeniuk - CAD Coordinator, Autodesk Certified Instructor

LinkedIn | My free Inventor Addin | My Repositories

Did you find this reply helpful ? If so please use the Accept as Solution/Like.

EESignature

Message 8 of 8

dypro
Advocate
Advocate
Accepted solution

Okey @Andrii_Humeniuk , even with my very little knowlege I managed to solve it, It was just a typo with a non defined variable (ofilename2) I replaced it with the good one and everything works like a charm!

 

Thankyou very much!!!!

PD: if you want to keep helping me a bit.... this one is driving me crazy... I don't know if it is even posible to do it
https://forums.autodesk.com/t5/inventor-ilogic-and-vb-net-forum/replace-title-block-borders-and-shee... 

0 Likes