I was able to achieve this with two separate codes - one on my model which opens drawings based on the name of the model state (model state name must match drawing name), then once all the sheets are open, I have a copy sheets to drawing code.
For those interested in functionality similar to this, here is my "Open Drawings" code:
Imports System.IO
Imports System.Windows.Forms
Sub Main()
Try
' Define the base folder path
Dim baseFolderPath As String = "C:\VaultWorkspace\InventorWorkspace"
' Check if the active document is an assembly
If ThisApplication.ActiveDocument.DocumentType <> kAssemblyDocumentObject Then
MessageBox.Show("The active document is not an assembly. Please open an assembly document and try again.", "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
Exit Sub
End If
' Get the active assembly document
Dim oAsmDoc As AssemblyDocument = ThisApplication.ActiveDocument
' Initialize lists to hold the file paths and display names of the drawings to be checked
Dim drawingFiles As New List(Of String)
Dim drawingDisplayNames As New List(Of String)
' HashSet to track processed sub-assemblies and model states
Dim processedSubAssemblies As New HashSet(Of String)
' Get the assembly component definition
Dim oCompDef As AssemblyComponentDefinition = oAsmDoc.ComponentDefinition
' Add the top-level assembly itself to the search
Dim topLevelAssemblyName As String = System.IO.Path.GetFileNameWithoutExtension(oAsmDoc.FullFileName)
Dim topLevelDrawingName As String = topLevelAssemblyName & ".idw"
drawingFiles.Add(topLevelDrawingName)
drawingDisplayNames.Add("Top-level Assembly: " & topLevelAssemblyName)
' Iterate through each component in the assembly
For Each oOccurrence As ComponentOccurrence In oCompDef.Occurrences
Try
' Check if the component is a subassembly
If oOccurrence.DefinitionDocumentType = kAssemblyDocumentObject Then
' Get the file name without extension
Dim fileNameWithoutExtension As String = System.IO.Path.GetFileNameWithoutExtension(oOccurrence.Definition.Document.FullFileName)
' Construct the model state name identifier
Dim modelStateIdentifier As String = oOccurrence.Name
' Retrieve the active model state name
Dim activeModelStateName As String = Component.ActiveModelState(modelStateIdentifier)
' Create a unique key combining the file name and model state
Dim uniqueKey As String = fileNameWithoutExtension & " | Model State: " & activeModelStateName
' Check if the sub-assembly with the model state has already been processed
If Not processedSubAssemblies.Contains(uniqueKey) Then
' Add the unique key to the HashSet
processedSubAssemblies.Add(uniqueKey)
' Get the full file name
Dim fullFileName As String = System.IO.Path.GetFileName(oOccurrence.Definition.Document.FullFileName)
' Create a display name for the checkbox
Dim displayName As String = "Sub-assembly: " & fullFileName & vbCrLf & "Active Model State: " & activeModelStateName
drawingDisplayNames.Add(displayName)
' Construct the expected drawing file name
Dim drawingFileName As String = fileNameWithoutExtension & " (" & activeModelStateName & ").idw"
drawingFiles.Add(drawingFileName)
End If
End If
Catch ex As Exception
MessageBox.Show("Error processing component: " & oOccurrence.Name & " - " & ex.Message, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
Next
' Show the custom form with dynamically created checkboxes
Dim selectedDrawings As List(Of String) = ShowSelectionFormWithCheckBoxes(drawingDisplayNames, drawingFiles)
If selectedDrawings.Count = 0 Then
MessageBox.Show("No drawings selected. Exiting.", "Selection Required", MessageBoxButtons.OK, MessageBoxIcon.Information)
Exit Sub
End If
' Initialize a string to hold the results of the drawing file checks
Dim drawingResults As String = ""
' Initialize lists to hold the found and not found drawing file paths
Dim foundDrawingFiles As New List(Of String)
Dim notFoundDrawingFiles As New List(Of String)
' Check if each selected drawing file exists in the entire directory structure and add the result to the display text
For Each drawingFile In selectedDrawings
Try
' First attempt: Search for drawing file with model state
Dim foundFiles As String() = Directory.GetFiles(baseFolderPath, drawingFile, SearchOption.AllDirectories)
' Check if found
If foundFiles.Length > 0 Then
foundDrawingFiles.Add(foundFiles(0)) ' Add to found files list
drawingResults &= "Drawing file found: " & drawingFile & vbCrLf
Else
' Prepare for secondary search
drawingResults &= "Drawing file not found: " & drawingFile & vbCrLf
notFoundDrawingFiles.Add(drawingFile) ' Add to not found files list
End If
' Add a separator line
drawingResults &= "------------------------" & vbCrLf
Catch ex As Exception
MessageBox.Show("Error searching for drawing file: " & ex.Message, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
Next
' Display the first message box with updated instructions
Dim openDrawingsResult As DialogResult = DisplayMessageInChunks(drawingResults, "Drawing File Check Results", 50, False, "Would you like to open the drawings that were found?")
' Always continue to the secondary search regardless of the user's response
Dim secondarySearchResults As String = ""
For Each drawingFile In notFoundDrawingFiles
Try
' Remove only the last set of parentheses and its content
Dim baseFileName As String = RemoveLastParentheses(drawingFile) & ".idw" ' Append the .idw extension
Dim foundFiles As String() = Directory.GetFiles(baseFolderPath, baseFileName, SearchOption.AllDirectories)
If foundFiles.Length > 0 Then
foundDrawingFiles.Add(foundFiles(0)) ' Add to found files list
secondarySearchResults &= "Drawing file found: " & baseFileName & vbCrLf
Else
secondarySearchResults &= "Drawing file still not found: " & baseFileName & vbCrLf
End If
' Add a separator line
secondarySearchResults &= "------------------------" & vbCrLf
Catch ex As Exception
MessageBox.Show("Error in secondary search: " & ex.Message, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
Next
' Display the third message box with updated instructions
Dim secondarySearchResultDialog As DialogResult = DisplayMessageInChunks(secondarySearchResults, "Secondary Search Results", 50, False, "Would you like to continue opening the drawings that were found?")
If secondarySearchResultDialog = DialogResult.Yes Then
' Open any newly found drawing files from the secondary search
For Each drawingFilePath In foundDrawingFiles
ThisApplication.Documents.Open(drawingFilePath, True)
Next
End If
Catch ex As Exception
MessageBox.Show("An unexpected error occurred: " & ex.Message, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
End Sub
' Function to display a custom form with dynamically created checkboxes
Function ShowSelectionFormWithCheckBoxes(drawingNames As List(Of String), drawingFiles As List(Of String)) As List(Of String)
Dim form As New Form()
form.Text = "Select Drawings to Open"
form.Width = 500
form.Height = 400
form.StartPosition = FormStartPosition.CenterScreen
Dim panel As New Panel()
panel.Dock = DockStyle.Fill
panel.AutoScroll = True
Dim checkBoxes As New List(Of CheckBox)()
' Add each checkbox dynamically
For i As Integer = 0 To drawingNames.Count - 1
Dim checkBox As New CheckBox()
checkBox.Text = drawingNames(i)
checkBox.AutoSize = True
checkBox.Top = i * 30 + 60 ' Adjust position for space after instruction
checkBox.Left = 10 ' Set left margin
panel.Controls.Add(checkBox)
checkBoxes.Add(checkBox)
Next
Dim instructionLabel As New Label()
instructionLabel.Text = "Please select which drawings you would like to open."
instructionLabel.Dock = DockStyle.Top
instructionLabel.Height = 40
form.Controls.Add(instructionLabel)
Dim okButton As New Button()
okButton.Text = "OK"
okButton.Dock = DockStyle.Bottom
okButton.Height = 30
AddHandler okButton.Click, Sub(sender, e)
form.DialogResult = DialogResult.OK
form.Close()
End Sub
form.Controls.Add(okButton)
form.Controls.Add(panel)
form.ShowDialog()
Dim selectedDrawings As New List(Of String)()
For Each checkBox In checkBoxes
If CheckBox.Checked Then
selectedDrawings.Add(drawingFiles(checkBoxes.IndexOf(CheckBox)))
End If
Next
Return selectedDrawings
End Function
' Function to remove the last set of parentheses and its content from a string
Function RemoveLastParentheses(fileName As String) As String
Dim lastIndex As Integer = fileName.LastIndexOf("(")
If lastIndex <> -1 Then
' Remove everything from the last opening parenthesis to the end of the string
fileName = fileName.Substring(0, lastIndex).TrimEnd()
End If
Return fileName
End Function
' Function to display message in chunks with OK or Yes/No buttons
Function DisplayMessageInChunks(message As String, title As String, maxLines As Integer, isOkButton As Boolean, Optional footerText As String = "") As DialogResult
Dim lines() As String = message.Split(New String() {vbCrLf}, StringSplitOptions.None)
Dim totalLines As Integer = lines.Length
Dim currentLine As Integer = 0
Dim result As DialogResult = DialogResult.None
While currentLine < totalLines
Dim chunk As String = ""
For i As Integer = 0 To maxLines - 1
If currentLine >= totalLines Then Exit For
chunk = chunk & lines(currentLine) & vbCrLf
currentLine += 1
Next
' Append the footer text to the chunk
If footerText <> "" Then
chunk = chunk & vbCrLf & footerText
End If
If isOkButton Then
MessageBox.Show(chunk, title, MessageBoxButtons.OK, MessageBoxIcon.Information)
Else
result = MessageBox.Show(chunk, title, MessageBoxButtons.YesNo, MessageBoxIcon.Information)
If result = DialogResult.No Then
Exit While
End If
End If
End While
Return result
End Function
And here is my "copy sheets to drawing" code:
Sub Main
' Ensure the active document is a drawing document
If ThisDoc.Document.DocumentType <> DocumentTypeEnum.kDrawingDocumentObject Then
MsgBox("A Drawing document must be active for this code to work. Exiting.", vbCritical, "")
Exit Sub
End If
' Define the active drawing document
Dim oDDoc As DrawingDocument = ThisDoc.Document
' Get all open documents
Dim openDocs As Documents = ThisApplication.Documents
' Iterate through all open documents
For Each doc As Document In openDocs
' Check if the document is a drawing document and not the active document
If doc.DocumentType = DocumentTypeEnum.kDrawingDocumentObject AndAlso doc.FullFileName <> oDDoc.FullFileName Then
Dim oOtherDrawing As DrawingDocument = doc
' Copy each sheet from the other drawing document to the active document
For Each oSheet As Sheet In oOtherDrawing.Sheets
oSheet.CopyTo(oDDoc)
Next
End If
Next
' Update the active document to reflect the copied sheets
oDDoc.Update2(True)
End Sub
