Split Multisheet Inventor DWG drawing into Separate files

[GKPByDesign]

I need help with code someone else I written about this issue. I have a mutlisheet dwg drawing created in inventor, but I need to split it into separate files. ie each page is a separate file. I have each sheet saved as the file name of the part saved, so I need a code that's saves the file by sheet name. Someone made this code attached which requires someone to run two codes, and it works fine, but now I am finding it is working very slow. Bear in mind the file is also loading items from vault etc. 

First Code: 

'RUN RULE will save-copy-as the existing multi-sheet Inventor DWG to new Inventor multisheet DWG's with the new file 
'names being the existing Sheet Names. To make life simple, you should rename each sheet to match the drawing shown. I havent worked out how to automate that yet.
'In the exmaple below the original multi sheet drawing is named in the format Region-DrawingNumber-Revsion Eg: FN-1234567-0A
'In the exmaple below the sheet names are in the format DrawingNumber-SheetNo. Eg: 1234567-01, 1234567-02
'Sooo....you may have to modify to suit.

Dim oDoc As Inventor.DrawingDocument
oDoc = ThisDoc.Document
Dim oSheet As Inventor.Sheet

'Get folder (using the same path as this doc)
folderName = ThisDoc.Path

	'Look at each sheet in drawing set
	For Each oSheet In oDoc.Sheets
		
	'Fix sheeet names for export, removing colon
	Try
	oName = Replace(oSheet.Name, ":", "-") 
	'Save sheets as Inventor DWGs
	
	'Remove what used to be a colon (:01,:02,:03 etc) & is now a dash (-01,-02,-03 etc)
	SheetName = oName
	ColonIndex = SheetName.LastIndexOf("-")
	SheetNameOnly = SheetName.Substring(0, ColonIndex)
		
	SaveName = SheetNameOnly
	
	'Save existing multi sheet drawing to new copies with new file names matching existing sheet names
	ThisDoc.Document.SaveAsInventorDWG(ThisDoc.Path & "\" & SaveName & ".dwg", True) 
	Catch
	End Try
	Next
  
  	'Message to tell the user the files were created
	MessageBox.Show("New *.dwg files created in: " _
	&folderName, "iLogic")

	'To delete sheets from newly saved drawings that do not match newly saved filename:
	
	'Look at Each sheet
	For Each oSheet In oDoc.Sheets
		
	'Fix name for search, removing colon
	Try
	oName = Replace(oSheet.Name, ":", "-") 
	
	'Remove what used to be a colon (:01,:02,:03 etc) & is now a dash (-01,-02,-03 etc)
	SheetName = oName
	ColonIndex = SheetName.LastIndexOf("-")
	SheetNameOnly = SheetName.Substring(0, ColonIndex)
		
	SaveName = SheetNameOnly
	
	'Open each newly created document indivdually & run external rule to delete all sheets that dont match new drawing number
	doc = ThisApplication.Documents.Open(ThisDoc.Path & "\" & SaveName & ".dwg", True) 
	auto = iLogicVb.Automation
	auto.RunExternalRule(doc, "STEP2-DELETE SHEETS") 
	'Have to save or it will do nothing
	doc.Save
	doc.Close(True)
	
	Catch
	End Try
	Next

Second code:

''From here sort of: https://forums.autodesk.com/t5/inventor-forum/using-ilogic-to-delete-a-sheet-from-a-drawing/td-p/5385055
'Drawing is multi-sheet Inventor DWG, with sheets named 
'1234567-01:1
'1234567-02:2
'1234567-03:3
'1234567-04:4
'1234567-05:5
'1234567-06:6
'1234567-07:7

'This doc file name is 1234567-01.dwg To get doc filename without extension ".dwg"
SName = ThisDoc.FileName(False)
'Gets File Name "1234567-01"

'Create name & add (:) to search sheets for deletion
oKeepsheet = SName & ":1"
'Should change to this: "1234567-01:1"

'Iterate through the sheets & delete everything that is not "1234567-01:1
Dim oSheet As Sheet
oSheetName = oKeepsheet
'oKeepsheet = "1234567-01:01" 
'If its (:02) in the series, I think it shouldn't matter as it will iterate until there is only (:01) left 

'Search drawing sheets and delete anything anything that is not Keepsheet = "1234567-01:01"   
For Each oSheet In ThisApplication.ActiveDocument.Sheets
	If oSheet.Name <> oSheetName Then
	oSheet.Delete
	End If
Next

[A.Acheson]

Hi @GKPByDesign 

Can you define what slow means? The script seems simple but where do you see the bottle neck to be? Can you record a video or indicate where the time is being lost? 

[GKPByDesign]

I have a drawing that is 163 sheets, it intially generates a file I guess using save as, it takes around 10-20 seconds for each sheet. However after waiting about an hour, it crashed. And I was left with 163 files each with 163 sheets on each. I cannot record anything as the data is confidential. I can see it runs well, but since adding more pages it is not working correctly 

[GKPByDesign]

When I run the code, it cycles the first code fine, when loading the second code (it self after pressing ok) it starts to do stuff, looks like it opens stuff, but crashes, and all files seem to be un touched with no deleted sheets. 

[A.Acheson]

Hi @GKPByDesign  here is a cleaned up single rule that should do what your after. I have removed the multiple loops and just pass the new filename to a sub routine to process the new drawing. I have placed in an index counter to only process two drawings so you can ensure it functions correctly . Delete this line or commented once you see it works correctly. The new drawing will process invisibly so you will need to check it by opening.  

   'For testing Exit after two loops to avoid loop all sheets. Remove if test is satisfactory.
		Dim i As Integer = i + 1
		MessageBox.Show("Finished Splitting Drawing", "Success")
		If i = 2 Then Exit Sub

Splitting Drawing:

Sub Main
	
	Dim drwDoc As DrawingDocument = ThisDoc.Document

	'Get folder using the same path as this doc.
	Dim folderName As String = ThisDoc.Path

	'Look at each sheet in drawing set.
	For Each sheet As Sheet In drwDoc.Sheets
	
		'Fix sheeet names for export, removing colon.
		Dim sheetName As String  = Sheet.Name
		Dim colonIndex As String = sheetName.LastIndexOf(":")
		Dim saveName As String = sheetName.Substring(0, colonIndex)
		Dim fullFileName As String = ThisDoc.Path & "\" & saveName & ".dwg"
		
		Try
			'Save existing multi Sheet drawing To New copies With New File names matching existing Sheet names.
			drwDoc.SaveAsInventorDWG(fullFileName, True) 
			
			'Call Sub Routine
			SaveNewDrawing(fullFileName)
		Catch
		End Try
		
		'For testing Exit after two loops to avoid loop all sheets. Remove if test is satisfactory.
		Dim i As Integer = i + 1
		MessageBox.Show("Finished Splitting Drawing", "Success")
		If i = 2 Then Exit Sub
	Next
	MessageBox.Show("Finished Splitting Drawing", "Success")

End Sub

Sub SaveNewDrawing(fullFileName As String)
	
	Dim newDrwDoc As DrawingDocument = ThisApplication.Documents.Open(fullFileName, False)
	
	Dim fileName As String = IO.Path.GetFileNameWithoutExtension(newDrwDoc.FullFileName)
	
	For Each sheet As Sheet In newDrwDoc.Sheets
		Dim sheetName As String = Sheet.Name
		If Not sheetName.StartsWith(fileName) Then
			Sheet.Delete
		End If
	Next
	newDrwDoc.Save
End Sub

[GKPByDesign]

While your code seems better and more efficient, my inventor crashed again, but this time with no error report? are you able to add code that is the drawing of the same name exists for it to skip that sheet? 

I will likely delete all files if I need to run code to amend 

[A.Acheson]

That seems odd that it crashes although I only tested this with two/three sheets. Can you narrow down if it is failing at drawing save as or sheet deletion? 

You could also put in a logger statement with filename and see on which file it crashes.

For the skipping of drawing with same name,

"are you able to add code that is the drawing of the same name exists for it to skip that sheet? "

If IO.File.Exists("File_Path_Here") Then Continue For 

[GKPByDesign]

It crashed on a mirror part like 60 sheets in on the file creation, as in it crashed on the deleting sheet code, I think it didnt actually delete on sheets on that file. I'll try this code. 

[GKPByDesign]

Where in the code should I pop this? 

I assume the start

[A.Acheson]

Just inside the try catch and before the save as line. Your trying to avoid a file being saved if it exists. 

Another thing to check is that your sheet names are not duplicated? 

You can use the below to check the filenames.  Check the list afterwards to ensure no duplicates and ensure they have valid filenames. No saving so your check will be quick. 

Sub Main
	
	Dim drwDoc As DrawingDocument = ThisDoc.Document

	'Get folder using the same path as this doc.
	Dim folderName As String = ThisDoc.Path

	'Look at each sheet in drawing set.
	For Each sheet As Sheet In drwDoc.Sheets
	
		'Fix sheeet names for export, removing colon.
		Dim sheetName As String  = Sheet.Name
		Dim colonIndex As String = sheetName.LastIndexOf(":")
		Dim saveName As String = sheetName.Substring(0, colonIndex)
		Dim fullFileName As String = ThisDoc.Path & "\" & saveName & ".dwg"
        
        Logger.Info("FullFileName: " & fullFileName)
	Next
	MessageBox.Show("Finished Splitting Drawing", "Success")

End Sub

[GKPByDesign]

It asking me to end an end, I am placing it a line below try as you have written it 

[A.Acheson]

I had forgotten the "Then" word in the line, corrected in previous post. It is a short way to write the line. 

[GKPByDesign]

it now says I0 is not declared?

[GKPByDesign]

I got the code to run, but it is still saving over existing files, I also need some sheets to be the same name, and the code you have done allows this anyway, I have another naming that make each sheet unique already 

[GKPByDesign]

Just to clarify, I need code that will work after a crash, ie, if there are 20 sheets, and say it crashes on sheet 10, I want to it to continue where it left off, ie sheet 10/11 by checking if there is a drawing already existing 

[A.Acheson · Accepted solution]

Hi @GKPByDesign 

Here is the code with check file name line and move to next sheet if it exists. 

Sub Main
	
	Dim drwDoc As DrawingDocument = ThisDoc.Document

	'Get folder using the same path as this doc.
	Dim folderName As String = ThisDoc.Path

	'Look at each sheet in drawing set.
	For Each sheet As Sheet In drwDoc.Sheets
	
		'Fix sheeet names for export, removing colon.
		Dim sheetName As String  = Sheet.Name
		Dim colonIndex As String = sheetName.LastIndexOf(":")
		Dim saveName As String = sheetName.Substring(0, colonIndex)
		Dim fullFileName As String = ThisDoc.Path & "\" & saveName & ".dwg"
		
		Try
			'Save existing multi Sheet drawing To New copies With New File names matching existing Sheet names.
             If IO.File.Exists("fullFileName") Then Continue For	 

drwDoc.SaveAsInventorDWG(fullFileName, True) 
			
			'Call Sub Routine
			SaveNewDrawing(fullFileName)
		Catch
		End Try
	Next
	MessageBox.Show("Finished Splitting Drawing", "Success")

End Sub

Sub SaveNewDrawing(fullFileName As String)
	
	Dim newDrwDoc As DrawingDocument = ThisApplication.Documents.Open(fullFileName, False)
	
	Dim fileName As String = IO.Path.GetFileNameWithoutExtension(newDrwDoc.FullFileName)
	
	For Each sheet As Sheet In newDrwDoc.Sheets
		Dim sheetName As String = Sheet.Name
		If Not sheetName.StartsWith(fileName) Then
			Sheet.Delete
		End If
	Next
	newDrwDoc.Save
End Sub

[johnsonshiue]

Hi! When Inventor crashed, did you send the crash report? If yes, please send me an email johnson.shiue@autodesk.com. I would like to understand the crash better.

Many thanks!

[GKPByDesign]

The code seems stable, but is there not a code to bulk delete any sheet that is not the same name, rather than deleting one at a time, as the deleting process of a large file is what takes ages, is there a way to delete all sheets not active? 

[GKPByDesign]

The code crashed again after running for about an hour, and also still does not skip existing drawing files and overwrites them. 

[A.Acheson · Accepted solution]

I see one issue in this line, it is looking for a static string and not the variable fullFilePath.

Incorrect:

If IO.File.Exists("fullFileName") Then Continue For	 

Searching for "fullFileName"

Correct:

If IO.File.Exists(fullFileName) Then Continue For

Searching for "C\Temp\123...dwg"

And unfortunately there is no batch delete, you have delete one at a time.