Count unique subassemblies
Hi @aurel_e. Something like this maybe? If there are multiple of the same sub assembly within the main assembly, and it has multiple ModelStates, and some of those component instances are set to different ModelStates, then this code might need to also include a List(Of String) to keep track of each document's FullFileName while checking. The FullDocumentName will include the name of the ModelState, so that would not be a good choice, depending on your needs.
Sub Main
If ThisDoc.Document.DocumentType <> DocumentTypeEnum.kAssemblyDocumentObject Then Return
Dim oADoc As AssemblyDocument = ThisDoc.Document
Dim oRefDocs As DocumentsEnumerator = oADoc.AllReferencedDocuments
Dim iCount As Integer = 0
For Each oRefDoc As Inventor.Document In oRefDocs
If oRefDoc.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then
iCount = iCount + 1
End If
Next
MsgBox("There are " & iCount & " unique sub assemblies in this assembly.", vbInformation, "iLogic")
End SubIf this solved your problem, or answered your question, please click ACCEPT SOLUTION .
Or, if this helped you, please click (LIKE or KUDOS) 👍.
Wesley Crihfield
(Not an Autodesk Employee)
Here is the version with the list and FullFileName check included, just in case that is what you need, due to ModelStates. If the referenced document is an assembly, and its FullFileName has not yet been added to the list, then we add its FullFileName to the list, and count it. If its FullFileName is already in the list, then it will not get counted.
Sub Main
If ThisDoc.Document.DocumentType <> DocumentTypeEnum.kAssemblyDocumentObject Then Return
Dim oADoc As AssemblyDocument = ThisDoc.Document
Dim oRefDocs As DocumentsEnumerator = oADoc.AllReferencedDocuments
Dim oList As New List(Of String)
Dim iCount As Integer = 0
For Each oRefDoc As Inventor.Document In oRefDocs
If oRefDoc.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then
If oList.Contains(oRefDoc.FullFileName) = False Then
oList.Add(oRefDoc.FullFileName)
iCount = iCount + 1
End If
End If
Next
MsgBox("There are " & iCount & " unique sub assemblies in this assembly.", vbInformation, "iLogic")
End Sub
Wesley Crihfield
(Not an Autodesk Employee)
Hi @aurel_e. Yes, that would be possible. But that brings several other questions to mind that the code would have to know how to deal with.
- Should the code create a new Excel file, or edit an existing Excel file?
- Should the code save the file when done, or leave it open for you to save manually afterwards?
- If opening an existing file:
- Where is the file, and what is its name, including extension?
- What is the name of the sheet you want it to work with within that file?
- Are there row or column headers present on that sheet?
- If so, where are they, and where does the real data start, and how is the data laid out?
- If creating a new file and/or sheet:
- Do you want row / column headers?...and if so, what should they be, and where?
- Should the data just be in the first column (column A), or somewhere else, and which Row index should the data start on?
- Just the one column of data, or will you need more columns of data?
- FullFileName (path, file name, and file extension), or FullDocumentName (FullFileName plus ModelStateName or iPart/iAssembly member name), or just DisplayName (file name only, without path - may or may not include file extension)?
Wesley Crihfield
(Not an Autodesk Employee)
Hi @aurel_e. Here is something you can try, or use as a starting point. There are lots of ways of doing something like this, and lots of ways of customizing it, but right now I am still using a regular List(Of String) filled with the FullFileName's of all the sub assemblies, and sending that to a custom Sub routine, that was designed to write a List(Of String) to Excel. I already had something like this, but for dealing with a Dictionary, instead of a List, so I just customized it a bit to add the 3 column headers, and write the data to the second column, instead of the first one.
Later, if you want to gather all 3 pieces of data from the assembly to send to the routine, you could create and use something like a List(Of List(Of String)) [a List of Lists of Strings] or a List(Of String()) [a List of String arrays], where the Part Number value would be the first String, then the file name would be the second String, and the Quantity could also be converted to a String as the third value. Then just change the Type of the first input, and change the code within that Sub routine a bit to handle the new data arrangement.
AddReference "Microsoft.Office.Interop.Excel.dll"
Imports Microsoft.Office.Interop
Imports Microsoft.Office.Interop.Excel
Sub Main
If ThisDoc.Document.DocumentType <> DocumentTypeEnum.kAssemblyDocumentObject Then Return
Dim oADoc As AssemblyDocument = ThisDoc.Document
Dim oRefDocs As DocumentsEnumerator = oADoc.AllReferencedDocuments
Dim oList As New List(Of String)
Dim iCount As Integer = 0
For Each oRefDoc As Inventor.Document In oRefDocs
If oRefDoc.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then
If oList.Contains(oRefDoc.FullFileName) = False Then
oList.Add(oRefDoc.FullFileName)
iCount = iCount + 1
End If
End If
Next
MsgBox("There are " & iCount & " unique sub assemblies in this assembly.", vbInformation, "iLogic")
'same path and file name as this assembly, but with ".xlsx" file extension
Dim sExcelFile As String = System.IO.Path.ChangeExtension(oADoc.FullFileName, ".xlsx")
WriteListToExcel(oList, sExcelFile)
End Sub
Sub WriteListToExcel(oList As List(Of String), Optional sExcelFileName As String = vbNullString, Optional sExcelSheetName As String = vbNullString)
If oList Is Nothing OrElse oList.Count = 0 Then Return
Dim oExcel As Excel.Application = GetExcel
If oExcel Is Nothing Then Return
oExcel.Visible = True
oExcel.DisplayAlerts = True
Dim oWB As Workbook = oExcel.Workbooks.Add()
If oWB Is Nothing Then Return
Dim oWS As Worksheet
If oWB.Worksheets.Count = 0 Then
oWS = oWB.Worksheets.Add()
Else
oWS = oWB.Worksheets.Item(1)
End If
If oWS Is Nothing Then Return
'add column headers
oWS.Range("A1").Value = "Part Number"
oWS.Range("B1").Value = "File Name"
oWS.Range("C1").Value = "Qty"
Dim oRow As Integer = 1 'row just above first data row, because loop increments before writing
For Each oEntry In oList
oRow = oRow + 1
'oEntry contains FullFileName (path, file name, and file extension), so we must isolate just file name
oWS.Cells(oRow, 2) = System.IO.Path.GetFileNameWithoutExtension(oEntry)
Next
oWS.Columns.AutoFit
Try
oWB.SaveAs(sExcelFileName)
Catch
MsgBox("Error trying to save this Excel file as the following:" & vbCrLf & sExcelFileName, vbCritical, "iLogic")
End Try
oWS = Nothing
oWB.Close(False)
oWB = Nothing
'oExcel.Quit 'should only quit, if a new instance of Excel was started, but we do not know that
oExcel = Nothing
End Sub
Function GetExcel(Optional bVisible As Boolean = False) As Excel.Application
Dim oXL As Excel.Application
Try 'try to find an already running instance of the Excel Application
oXL = GetObject(, "Excel.Application")
Catch 'it wasn't found open, so create an instance of it (start the application)
Try : oXL = CreateObject("Excel.Application") : Catch : End Try
End Try
If oXL IsNot Nothing Then oXL.Visible = bVisible
Return oXL
End FunctionIf this solved your problem, or answered your question, please click ACCEPT SOLUTION .
Or, if this helped you, please click (LIKE or KUDOS) 👍.
Wesley Crihfield
(Not an Autodesk Employee)
I do not know why some people encounter that problem and I do not. I tested the code on my end, and it worked OK, without any errors. You may need to change ...
As Excel.Application
...to
As Object...in the two places it is found in that rule (Line 26 and Line 62, and Line 63 for me). That will cause you to loose Intellisense recognition of that object, but the code should still work OK. Give it a try and let me know.
Wesley Crihfield
(Not an Autodesk Employee)
And sometimes this strategy can work better for when you need to start a new instance of the Excel application, but I do not use this one that much. Below is a very simple example rule, just for testing, to see if it will work for you, without any errors.
AddReference "Microsoft.Office.Interop.Excel.dll"
Imports Microsoft.Office.Interop
Imports Microsoft.Office.Interop.Excel
Dim oExcel As New Microsoft.Office.Interop.Excel.ApplicationClass
oExcel.Visible = True
oExcel.DisplayAlerts = False
MsgBox("Notice that a 'New' instance of Excel just opened." & _
vbCrLf & "And when you close this message, that instance of Excel will be closed.", _
vbInformation, "iLogic")
oExcel.Quit
oExcel = NothingWesley Crihfield
(Not an Autodesk Employee)
It's showing another error now: {000208DA-0000-0000-C000-000000000046}
This is the code:
AddReference "Microsoft.Office.Interop.Excel.dll"
Imports Microsoft.Office.Interop
Imports Microsoft.Office.Interop.Excel
Sub Main
If ThisDoc.Document.DocumentType <> DocumentTypeEnum.kAssemblyDocumentObject Then Return
Dim oADoc As AssemblyDocument = ThisDoc.Document
Dim oRefDocs As DocumentsEnumerator = oADoc.AllReferencedDocuments
Dim oList As New List(Of String)
Dim iCount As Integer = 0
For Each oRefDoc As Inventor.Document In oRefDocs
If oRefDoc.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then
If oList.Contains(oRefDoc.FullFileName) = False Then
oList.Add(oRefDoc.FullFileName)
iCount = iCount + 1
End If
End If
Next
MsgBox("There are " & iCount & " unique sub assemblies in this assembly.", vbInformation, "iLogic")
'same path and file name as this assembly, but with ".xlsx" file extension
Dim sExcelFile As String = System.IO.Path.ChangeExtension(oADoc.FullFileName, ".xlsx")
WriteListToExcel(oList, sExcelFile)
End Sub
Sub WriteListToExcel(oList As List(Of String), Optional sExcelFileName As String = vbNullString, Optional sExcelSheetName As String = vbNullString)
If oList Is Nothing OrElse oList.Count = 0 Then Return
Dim oExcel As Object = GetExcel
If oExcel Is Nothing Then Return
oExcel.Visible = True
oExcel.DisplayAlerts = True
Dim oWB As Workbook = oExcel.Workbooks.Add()
If oWB Is Nothing Then Return
Dim oWS As Worksheet
If oWB.Worksheets.Count = 0 Then
oWS = oWB.Worksheets.Add()
Else
oWS = oWB.Worksheets.Item(1)
End If
If oWS Is Nothing Then Return
'add column headers
oWS.Range("A1").Value = "Part Number"
oWS.Range("B1").Value = "File Name"
oWS.Range("C1").Value = "Qty"
Dim oRow As Integer = 1 'row just above first data row, because loop increments before writing
For Each oEntry In oList
oRow = oRow + 1
'oEntry contains FullFileName (path, file name, and file extension), so we must isolate just file name
oWS.Cells(oRow, 2) = System.IO.Path.GetFileNameWithoutExtension(oEntry)
Next
oWS.Columns.AutoFit
Try
oWB.SaveAs(sExcelFileName)
Catch
MsgBox("Error trying to save this Excel file as the following:" & vbCrLf & sExcelFileName, vbCritical, "iLogic")
End Try
oWS = Nothing
oWB.Close(False)
oWB = Nothing
'oExcel.Quit 'should only quit, if a new instance of Excel was started, but we do not know that
oExcel = Nothing
End Sub
Function GetExcel(Optional bVisible As Boolean = False) As Object
Dim oXL As Object
Try 'try to find an already running instance of the Excel Application
oXL = GetObject("Excel.Application")
Catch 'it wasn't found open, so create an instance of it (start the application)
Try : oXL = CreateObject("Excel.Application") : Catch : End Try
End Try
If oXL IsNot Nothing Then oXL.Visible = bVisible
Return oXL
End Function
It looks is the Office 365, that causes the problem.
If it is too hard to fix, a txt file will do.
Thanks.
Sorry to hear about your Excel code related issues. Maybe when changing the Excel Application object to be an 'Object' type variable, the WorkBook, WorkSheet, and other Excel related objects would also need to be identified as Object, in an attempt to avoid all Type conversion issues. Some folks do it that way, and do not even include those first 3 lines of code that automatically go into the 'Header' of the rule, to help with Excel API object recognition, but since I do not seem to have any troubles in that area, I have used them for years now. I am using Windows 10 Enterprise 64 bit, and Office 365, on a Dell Desktop Work PC. The iLogic 'GoExcel' stuff may work better for you, if the direct Excel API code route does not, but you can not start a new Excel file with the 'GoExcel' tools...that I can recall. You would have to Open an already existing file, and work with an already existing Sheet within that file.
Text file:
This example below just writes the list of sub-assembly file names to a new text file. The new text file will have the same path and file name as the main assembly, but with the ".txt" file extension. I also added list header line "SUB-ASSEMBLY FILE NAMES:" as the first line of text at the top of the text file, but of course you can change that however you want. The main rule is exactly the same, except for a few minor changes in the last 3 lines. The variable name and file extension was changed in Line 17. The name of the custom routine changed, and the new variable from Line 17 was used in Line 18. Then I added a line to launch the newly created Text file, so you can immediately review it, after it gets created, but if that is not needed, you can always comment that line out, or delete it.
I also tested this in a small multi-level assembly, and it seemed to work just fine for me. Hopefully it will work OK for you too.
Sub Main
If ThisDoc.Document.DocumentType <> DocumentTypeEnum.kAssemblyDocumentObject Then Return
Dim oADoc As AssemblyDocument = ThisDoc.Document
Dim oRefDocs As DocumentsEnumerator = oADoc.AllReferencedDocuments
Dim oList As New List(Of String)
Dim iCount As Integer = 0
For Each oRefDoc As Inventor.Document In oRefDocs
If oRefDoc.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then
If oList.Contains(oRefDoc.FullFileName) = False Then
oList.Add(oRefDoc.FullFileName)
iCount = iCount + 1
End If
End If
Next
MsgBox("There are " & iCount & " unique sub assemblies in this assembly.", vbInformation, "iLogic")
'same path and file name as this assembly, but with ".xlsx" file extension
Dim sTextFile As String = System.IO.Path.ChangeExtension(oADoc.FullFileName, ".txt")
WriteListToTextFile(oList, sTextFile)
ThisDoc.Launch(sTextFile)
End Sub
Sub WriteListToTextFile(oList As List(Of String), sNewFullFileName As String)
If oList Is Nothing OrElse oList.Count = 0 Then Return
Using oWriter As System.IO.StreamWriter = System.IO.File.CreateText(sNewFullFileName)
oWriter.WriteLine("SUB-ASSEMBLY FILE NAMES:")
For Each oEntry In oList
'oEntry contains FullFileName (path, file name, and file extension), so we must isolate just file name
oWriter.WriteLine(System.IO.Path.GetFileNameWithoutExtension(oEntry))
Next
oWriter.Close
End Using
End SubIf this solved your problem, or answered your question, please click ACCEPT SOLUTION .
Or, if this helped you, please click (LIKE or KUDOS) 👍.
Wesley Crihfield
(Not an Autodesk Employee)
