Compile a new Drawing from multiple Drawings

emanuel.c · ‎01-09-2023

I'm working on this piece of code and I would like to compile .dwg drawing files:

- I have existing .dwg drawings of Assemblies and Sub-Assemblies (or Parts)

- An Excel Spreadsheet contains some info, including a column with the text "Assembly" for any top level Assembly. I would like to compile a new Drawing made up of any "Sub Drawings" which would be involved in an Assembly.

My method was this, but I'm more than happy to receive input, to better it:

Look thru Excel spreasheet

If "Assembly" is found

Copy first 3 Letters from column "A"

If a .dwg Drawing in the folder contains these numbers

Open this Drawing (It may be better to open drawings silently? Copy and Close, etc.?)

Iterate thru Parts list found on first page of Drawing and open any other drawings of those parts

It should iterate until there isn't anything new to open (not sure if the way I have it does this well)

Open a New Drawing from Template

Copy all opened drawings to New Drawing

Sort Sheets Alphabetically

Save New Drawing

Close All .dwg files - I suppose I would need an .ipt opened to be able run the code from

Do this for all files containing "Assembly" in Excel

I've been working on this for a while and for now bogged down at Opening New Drawing and copying all sheets to it.

Also the iteration to open files may not quite be working perfectly. It seems to try to open the file multiple times.

I'm very grateful for any help!

Public Sub Main()

'Open Excel Spreadsheet. Read column "C" -> Search for "Assembly"
GoExcel.Open(ExcelFile, "Sheet1")
	For i = 3 To 300
		If GoExcel.CellValue("C" & i) = ("Assembly")
			Dim ProjNum As String = GoExcel.CellValue("A" & i)
			Dim FileLocation As System.IO.DirectoryInfo = New System.IO.DirectoryInfo(WorkFolder)				
			Dim fi As System.IO.FileInfo() = FileLocation.GetFiles("*" & ProjNum & "*")			
			For Each oFile As System.IO.FileInfo In fi
				'Get only DWG files - Not PDFs or other files
				DwgFile = Left(oFile.FullName, Len(oFile.FullName) -3) & "dwg"
				Try
					open = ThisApplication.Documents.Open(DwgFile, True)
				Catch
					'MessageBox.Show("Drawing Is Already Opened", "Title")
				End Try
			Next
			
			'Call Sub to Open Drawings of Sub-Assemblies and Sub-Parts found on first sheet of Drawing
			OpenPartDwg		
			
			'Open a New Drawing Document ".dwg" from Template
			Dim oDoc As Document
			'Location of Drawing Template
			oCopyFiler = "D:\Drawings Test\cf.dwg"
			'Open Template
			open = ThisApplication.Documents.Open(oCopyFiler, True)
			
			'Save New Drawing as "ProjectNumber, AssemblyName, WeldmentName + "Complete Drawings" "
			Dim AsName As String = GoExcel.CellValue("B" & i)
			Dim WeldmentName As String = GoExcel.CellValue("D" & i)
			Dim DrawingName As String
			DrawingName = ProjNum & " - " & AsName & " - " & WeldmentName & " - " & "Complete Drawings"
			'MessageBox.Show(DrawingName)
			
			' New Location to Save Compiled Drawing
			Dim oNewSubPath As String = "\Complete Assembly Drawings"
			oNewPath = WorkFolder & oNewSubPath
			
			'New Drawing Save As
			oDoc.SaveAs(oNewPath & DrawingName & ".dwg", False) 'overwrite file if one already exists
			
			Dim oNewDrawing As DrawingDocument = ThisApplication.Documents.Open(DrawingName,False)
			For Each oDoc In ThisApplication.Documents.VisibleDocuments
	        	If oDoc.DocumentType = kDrawingDocumentObject Then
					'Copy all sheets of all opened kDrawingDocs into the New Opened Template
					For Each oSheet As Sheet In oDoc.Sheets
						oSheet.CopyTo(oNewDrawing)
					Next
				End If
	    	Next oDoc
			
			'Call Sub to rename sheets
			RenameSheets
			'Call Sub to sort all Drawing Sheets alphabetically
			SortDrawingSheets
			
			'Re-Save the New Created Document
			ThisDoc.Save
			
			'Close all opened Drawing files
			Dim oApp As Inventor.Application = ThisApplication
			For Each oDoc In oApp.Documents.kDrawingDocumentObject
				oDoc.Close(True)
			Next
	
		End If
	
	Next

End Sub

Public Function ExcelFile As String
	Dim eFileName As String = "\TPB Project Numbers.xlsx"
	Dim eFile As String = WorkFolder & eFileName
	Return eFile
End Function

Public Function WorkFolder As String
	Dim wFolder As String = "D:\Drawings Test\1 Drawings"
	Return wFolder
End Function

Public Sub OpenPartDwg

Dim oDrawDoc As DrawingDocument = ThisApplication.ActiveDocument
Dim oDrawingView As DrawingView
Dim oSheet As Sheet = oDrawDoc.ActiveSheet
Dim oPartList As PartsList
oPartList = oSheet.PartsLists(1)
Dim drawBomRow As DrawingBOMRow
Dim refDoc As Document

For Each oPartListRow In oPartList.PartsListRows
	If oPartListRow.Visible = "True" Then
		drawBomRow = oPartListRow.ReferencedRows.Item(1)
		refDoc = drawBomRow.BOMRow.ComponentDefinitions.Item(1).Document
		FilePath = refDoc.FullFileName()
		FilePath = Left(FilePath, Len(FilePath) -3) & "dwg"
		
		For j = 1 To oPartList.PartsListRows.Count
			oCell = oPartList.PartsListRows.Item(j).Item("PART NUMBER")
			Dim oItemValue As String
			oItemValue = oCell.Value
			PartProj = Left(oItemValue,3)
			'MessageBox.Show(PartProj, "This is the Part Project Number:")
			
			Dim FileLocation As System.IO.DirectoryInfo = New System.IO.DirectoryInfo(WorkFolder)				
			Dim fi As System.IO.FileInfo() = FileLocation.GetFiles("*" & PartProj & "*")
			
			For Each oFile2 As System.IO.FileInfo In fi
				'MessageBox.Show(oFile2, "Drawing Name:")
				DwgFile = Left(oFile2.FullName, Len(oFile2.FullName) -3) & "dwg"
				Try
					open = ThisApplication.Documents.Open(DwgFile, True)
				Catch
					'MessageBox.Show("Drawing Is Already Opened", "Title")
				End Try
			Next	
		Next
	End If
Next

End Sub

'Sort Drawing Sheets by Sheet Name (equals Part Name)
Public Sub SortDrawingSheets
    Dim drawingDoc As DrawingDocument = ThisDoc.Document
    Dim sheet As Sheet = Nothing
    Dim sheetsList As New List(Of sheet)
    Dim browserPane As BrowserPane = drawingDoc.BrowserPanes.Item("Model")
    
    For Each sheet In drawingDoc.Sheets
        sheetsList.Add(sheet)
    Next
    sheetsList.Sort(AddressOf Comparer)
    For Each sheet In sheetsList
        Dim sheetNode As BrowserNode = browserPane.GetBrowserNodeFromObject(sheet)
        Dim bottomNode As BrowserNode = browserPane.TopNode.BrowserNodes.Item(browserPane.TopNode.BrowserNodes.Count)
        browserPane.Reorder(bottomNode, False, sheetNode)
    Next
End Sub

Private Function Comparer(x As Sheet, y As Sheet) As Integer
    Return String.Compare(x.Name, y.Name)
End Function

Public Sub RenameSheets
    If TypeOf ThisDoc.Document Is DrawingDocument Then
        Dim dwgDoc As DrawingDocument = ThisDoc.Document
        For Each dwgSheet As Sheet In dwgDoc.Sheets
            If dwgSheet.DrawingViews.Count > 0 Then
                modelFile = dwgSheet.DrawingViews(1).ReferencedDocumentDescriptor.FullDocumentName
                modelDoc = dwgSheet.DrawingViews(1).ReferencedDocumentDescriptor.ReferencedDocument
                prtNumber = modelDoc.PropertySets("{32853F0F-3444-11D1-9E93-0060B03C1CA6}").ItemByPropId(5).Value
                If Not String.IsNullOrEmpty(prtNumber) Then
                    dwgSheet.Name = prtNumber
                End If
            End If
        Next
    End If
End Sub

WCrihfield · ‎01-09-2023

Hi @emanuel.c. Not posting a solution, but just something to think about in this project. Do the sheets in all those drawings contain borders or title blocks that contain 'linked' references to information like 'model' parameters or 'model' iProperties? If so, when you copy all of them over to one new huge drawing file, what 'model' will they be 'linked' to, because there will be tons of 'models' at that point, not just one. I don't think you can use anything like a file dialog box to select which 'model' it will refer to when creating those 'linked' referenced textboxes. Just something to keep in mind. But if you don't use any 'linked' references in any of those borders, title blocks, or sketched blocks, then you may not have to worry about it.

Wesley Crihfield

(Not an Autodesk Employee)

emanuel.c · ‎01-09-2023

@WCrihfield Thank you for the thought. No, I don't actually have Referenced info as such.

To be honest, my end result is PDF Compiled Drawings and in a way I could just skip the Compile to .dwg. It's just that I have the code to batch print .dwg to PDF so I chose this route, but I don't plan to edit these compiled .dwg drawings, but rather recompile and re-print to PDF should there be modifications to "child" drawings...

I suppose I could compile the .dwg, print to PDF and close everything without saving...

Thank you!

emanuel.c · ‎01-12-2023

I'm going to post what I have up to this point, even though it's a custom project - maybe parts of it could be helpful to someone else. I sure couldn't do it without this forum 🙂

I think it's working OK. I might have to adjust the code to run through sub-sub assemblies (in other words, Grandparent - Parent - Child drawings if you will).

Public Sub Main()

'Open Excel Spreadsheet. Read column "C" -> Search for "Assembly"
GoExcel.Open(ExcelFile, "Sheet1")
	For i = 3 To 300
		If GoExcel.CellValue("C" & i) = ("Assembly")
			Dim ProjNum As String = GoExcel.CellValue("A" & i)
			Dim FileLocation As System.IO.DirectoryInfo = New System.IO.DirectoryInfo(WorkFolder)
			Dim fi As System.IO.FileInfo() = FileLocation.GetFiles("*" & ProjNum & "*")
			
			For Each oFile As System.IO.FileInfo In fi
				'Get only DWG files - Not PDFs or other files
				DwgFile = Left(oFile.FullName, Len(oFile.FullName) -3) & "dwg"				
				Try
					ThisApplication.Documents.Open(DwgFile, True)
				Catch
					'MessageBox.Show("Drawing Is Already Opened", "Title")
				End Try
			Next		

			'Call Sub to Open Drawings of Sub-Assemblies and Sub-Parts found on first sheet of Drawing			
			OpenPartDwg
			
			'Begin Work on Compiled Drawing
			
			'Specify Location of Drawing Template
			oTemplate = WorkFolder & "\Test.dwg"
			'Open a New Drawing Document ".dwg" from Template
			ThisApplication.Documents.Open(oTemplate, True)					
			
			'Define the active document
			Dim oDoc As Inventor.Document = ThisApplication.ActiveDocument						
			Dim oNewDrawing As DrawingDocument = ThisApplication.Documents.Open(oTemplate)
			For Each oDoc In ThisApplication.Documents.VisibleDocuments
				'Don't copy Sheets from Compiled Drawing itself / Omit if oDoc Name = Template Name
				OpenedDocName = oDoc.FullDocumentName
	        	If oDoc.DocumentType = kDrawingDocumentObject And OpenedDocName <> oTemplate Then
					'Copy all sheets of all opened kDrawingDocs into the New Opened Template
					For Each oSheet As Sheet In oDoc.Sheets
						oSheet.CopyTo(oNewDrawing)
					Next
				End If
	    	Next oDoc
			
			'Delete the first sheet, which is blank
			DeleteFirstSheet
			
			'Call Sub to rename sheets
			'RenameSheets
			
			'Call Sub to sort all Drawing Sheets alphabetically
			SortDrawingSheets			
			
			'Specify New Location to Save Compiled Drawing
			Dim oNewSubPath As String = "\Complete Assembly Drawings"
			oNewPath = WorkFolder & oNewSubPath
			
			'Save New Drawing Name as "ProjectNumber, AssemblyName, WeldmentName + "Complete Drawings" "
			Dim AssemblyDescription As String = GoExcel.CellValue("B" & i)
			Dim WeldmentName As String = GoExcel.CellValue("D" & i)
			Dim DrawingName As String
			DrawingName = oNewPath & "\" & ProjNum & " (Full) - " & AssemblyDescription & " - " & WeldmentName & ".dwg"
			
			Try
				oDoc.SaveAs(DrawingName, False)
			Catch
				MessageBox.Show("Can't Save a New File. It is already opened!", "Save As - Error")
				Exit Sub
			End Try
			
			'In the end close all opened Drawing files
			'CloseDrawings			
	
		End If
	
	Next

End Sub

Public Function ExcelFile As String
	Dim eFileName As String = "\TPB Project Numbers.xlsx"
	Dim eFile As String = WorkFolder & eFileName
	Return eFile
End Function

Public Function WorkFolder As String
	Dim wFolder As String = "D:\Shop Drawings\1 Drawings"
	Return wFolder
End Function

'Open Assembly or Part Drawing
Public Sub OpenPartDwg

Dim oDrawDoc As DrawingDocument = ThisApplication.ActiveDocument
Dim oDrawingView As DrawingView
Dim oSheet As Sheet = oDrawDoc.ActiveSheet
Dim oPartList As PartsList
oPartList = oSheet.PartsLists(1)
Dim drawBomRow As DrawingBOMRow
Dim FileLocation As System.IO.DirectoryInfo = New System.IO.DirectoryInfo(WorkFolder)

For Each oPartListRow In oPartList.PartsListRows
	If oPartListRow.Visible = "True" Then
		drawBomRow = oPartListRow.ReferencedRows.Item(1)
		For j = 1 To oPartList.PartsListRows.Count
			'Get Column "Part Number"
			oCell = oPartList.PartsListRows.Item(j).Item("PART NUMBER")
			'Get First 3 Numbers of Part Number
			Dim PartProjNum As String = Left(oCell.Value, 3)							
			Dim fi As System.IO.FileInfo() = FileLocation.GetFiles("*" & PartProjNum & "*")
			
			For Each oFile2 As System.IO.FileInfo In fi
				DwgSubFile = Left(oFile2.FullName, Len(oFile2.FullName) -3) & "dwg"
				Try
					'Try to name Document to see if it's already opened
					Dim SearchDoc As Document = ThisApplication.Documents.ItemByName(DwgSubFile)
					Catch
						Try
							open = ThisApplication.Documents.Open(DwgSubFile, True)
						Catch
					End Try
				End try	
			Next	
		Next	
	End If
Next

End Sub

'Sort Drawing Sheets by Sheet Name (equal to Part Name)

Public Sub SortDrawingSheets
'https://forums.autodesk.com/t5/inventor-ilogic-and-vb-net-forum/ilogic-sort-sheets-by-sheet-name-in-open-drawing/td-p/8940927
On Error Resume Next
Dim drawingDoc As DrawingDocument = ThisDoc.Document
Dim Sheet As Sheet = Nothing
Dim sheetsList As New List(Of Sheet)
Dim BrowserPane As BrowserPane = drawingDoc.BrowserPanes.Item("Model")

For Each Sheet In drawingDoc.Sheets
	sheetsList.Add(Sheet)
Next

sheetsList.Sort(AddressOf Comparer)

For Each Sheet In sheetsList
	Dim sheetNode As BrowserNode = BrowserPane.GetBrowserNodeFromObject(Sheet)
	Dim bottomNode As BrowserNode = BrowserPane.TopNode.BrowserNodes.Item(BrowserPane.TopNode.BrowserNodes.Count)
	BrowserPane.Reorder(bottomNode, False, sheetNode)
Next
End Sub

Public Function Comparer(x As Sheet, y As Sheet) As Integer
    Return String.Compare(x.Name, y.Name)
End Function

Public Sub RenameSheets
    If TypeOf ThisDoc.Document Is DrawingDocument Then
        Dim dwgDoc As DrawingDocument = ThisDoc.Document
        For Each dwgSheet As Sheet In dwgDoc.Sheets
            If dwgSheet.DrawingViews.Count > 0 Then
                modelFile = dwgSheet.DrawingViews(1).ReferencedDocumentDescriptor.FullDocumentName
                modelDoc = dwgSheet.DrawingViews(1).ReferencedDocumentDescriptor.ReferencedDocument
                prtNumber = modelDoc.PropertySets("{32853F0F-3444-11D1-9E93-0060B03C1CA6}").ItemByPropId(5).Value
                If Not String.IsNullOrEmpty(prtNumber) Then
                    dwgSheet.Name = prtNumber
                End If
            End If
        Next
    End If
End Sub

Public Sub CloseDrawings
	
Dim oDoc As Inventor.Document
Dim oApp As Inventor.Application = ThisApplication
For Each oDoc In oApp.Documents
	If TypeOf oDoc Is DrawingDocument
	oDoc.Close(True)
End If
Next

End Sub

Public Sub DeleteFirstSheet
'Assume First Sheet Name containts "Sheet" all others don't
Dim oSheet As Sheet
	For Each oSheet In ThisApplication.ActiveDocument.Sheets
		If oSheet.Name.Contains("Sheet:1") Then
		oSheet.Delete
	End If
	Next			
End Sub

Community

Compile a new Drawing from multiple Drawings

Compile a new Drawing from multiple Drawings

Compile a new Drawing from multiple Drawings