Announcements
Attention for Customers without Multi-Factor Authentication or Single Sign-On - OTP Verification rolls out April 2025. Read all about it here.
Andrii_Humeniuk
in reply to: KWarrenCA

Hi @KWarrenCA . Now I modified the GetListComponents() function to work with Occurrences. Note that the current Occurrence check on lines 45-47 uses a GoTo statement to be able to process components in the middle of the current Occurrence, if you need to skip it and not read the components in the subassembly you need to replace GoTo SkipWritingList with Continue For

Sub Main()
Dim oDoc As Document = ThisApplication.ActiveDocument
Dim oDrawDoc As DrawingDocument = oDoc
Dim oSheet As Sheet = oDrawDoc.Sheets.Item(1)
oRevTableDateColumn = 1
If oSheet.RevisionTables.Count > 0
	Dim oTable As RevisionTable = oSheet.RevisionTables.Item(1)
	Dim oRows As RevisionTableRows = oTable.RevisionTableRows
	Dim oRow As RevisionTableRow = oRows.Item(oRows.Count)
	RevCheck = oRow.Item(oRevTableDateColumn).Text
Else
	i = MessageBox.Show("Place a revision table!", "Need Revision Table", MessageBoxButtons.OK, MessageBoxIcon.Warning, MessageBoxDefaultButton.Button1)
	Return
End If

If TypeOf oDoc Is DrawingDocument Then
	If oSheet.DrawingViews.Count <> 0 Then
		Dim oView As DrawingView = oSheet.DrawingViews.Item(1)
		Dim oRefDoc As Document = oView.ReferencedDocumentDescriptor.ReferencedDocument
		If TypeOf oRefDoc Is AssemblyDocument Then
			Dim oAssDoc As AssemblyDocument = oRefDoc
			Dim oListComp As New Dictionary(Of String, Integer)
			Dim oOccs As ComponentOccurrences = oAssDoc.ComponentDefinition.Occurrences
			Call GetListComponents(oOccs, oListComp)
			Dim sNameTable As String = "ACC LIST - " & System.IO.Path.GetFileNameWithoutExtension(oAssDoc.FullDocumentName)
			Call CreatTable(oSheet, oListComp, sNameTable)
			Call ExportList(RevCheck, sNameTable)
			Call PID(RevCheck, sNameTable)
		Else
			MessageBox.Show("A table can only be created for AssemblyDocument.", "Error!", MessageBoxButtons.OK, MessageBoxIcon.Error)
		End If
	Else
		MessageBox.Show("There are no DrawingViews on the first sheet.", "Error!", MessageBoxButtons.OK, MessageBoxIcon.Error)
	End If
Else
	MessageBox.Show("Active document is not Drawing Document.", "Error!", MessageBoxButtons.OK, MessageBoxIcon.Error)
End If
Events()
End Sub

Private Function GetListComponents(ByVal oOccs As ComponentOccurrences, ByRef oListComp As Dictionary(Of String, Integer))
	For Each oOcc As ComponentOccurrence In oOccs
		Dim oDoc As Document = oOcc.Definition.Document
		Dim oDesign As PropertySet = oDoc.PropertySets("Design Tracking Properties")
		If oOcc.BOMStructure = BOMStructureEnum.kReferenceBOMStructure Or
			oOcc.Definition.BOMStructure = BOMStructureEnum.kReferenceBOMStructure Or
			oDesign("Cost Center").Value <> "ACC" Then GoTo SkipWritingList
		Dim sStokNumb As String = oDesign("Stock Number").Value
		'Dim folderpath As String = oDoc.PropertySets.Item("Design Tracking Properties").Item("Location").Value
		Dim folderpath As String = oDoc.File.FullFileName
		'defines backslash as the subdirectory separator
		Dim strCharSep As String = System.IO.Path.DirectorySeparatorChar
		'find the postion of the last backslash in the path
		FNamePos = InStrRev(folderpath, "\", -1)
		'get the file name with the file extension
		Name = Right(folderpath, Len(folderpath) -FNamePos)
		'get the path of the folder containing the file
		Folder_Location = Left(folderpath, Len(folderpath) -Len(Name) -1)
		'Sets export location for batch plot pdf location
		Dim NewFilePath As String = "X:\7 - Design\0 - Batch Plot Drawings\" + Folder_Location.Substring(16) + "\"
		If oListComp.ContainsKey(sStokNumb & NewFilePath) Then
			oListComp(sStokNumb & NewFilePath) = oListComp(sStokNumb & NewFilePath) + 1
		Else
			oListComp.Add(sStokNumb & NewFilePath, 1)
		End If
		SkipWritingList :
		If oOcc.SubOccurrences IsNot Nothing Then
			If oOcc.SubOccurrences.Count <> 0 Then Call GetListComponents(oOcc.SubOccurrences, oListComp)
		End If
	Next
End Function

Private Function CreatTable(ByVal oSheet As Sheet, ByVal oListComp As Dictionary(Of String, Integer), ByVal sNameTable As String)
	Dim oCustomTable As CustomTable
	For Each otable As CustomTable In oSheet.CustomTables
		If otable.Title = sNameTable Then
			oCustomTable = otable
		End If
	Next
	If oCustomTable Is Nothing Then
		Dim oTitles(3) As String
		oTitles(0) = "ACC #"
		oTitles(1) = "STOCK NUMBER"
		oTitles(2) = "QTY"
		oTitles(3) = "HYPERLINK"
		Dim oPlacementPoint As Point2d = ThisApplication.TransientGeometry.CreatePoint2d(.9525, 14.6288)
		oCustomTable = oSheet.CustomTables.Add(sNameTable, oPlacementPoint, 4, oListComp.Count, oTitles)
		oCustomTable.Columns.Item(1).Width = 2
		oCustomTable.Columns.Item(2).Width = 6
		oCustomTable.Columns.Item(3).Width = 2
		oCustomTable.Columns.Item(4).Width = .001
		oCustomTable.ShowTitle = True
		'oCustomTable.TableDirection = kBottomUpDirection
		'oCustomTable.HeadingPlacement = kHeadingAtBottom
		oCustomTable.WrapAutomatically = False
		'oCustomTable.MaximumRows=30
		oHeightCustomTable = oCustomTable.RangeBox.MaxPoint.Y - oCustomTable.RangeBox.MinPoint.Y
		oTablePt = ThisApplication.TransientGeometry.CreatePoint2d(.9525, oHeightCustomTable + .9525)
		oCustomTable.Position = oTablePt
	Else
		If oCustomTable.Rows.Count < oListComp.Count Then
			For i = oCustomTable.Rows.Count + 1 To oListComp.Count
				oCustomTable.Rows.Add()
			Next i
			oHeightCustomTable = oCustomTable.RangeBox.MaxPoint.Y - oCustomTable.RangeBox.MinPoint.Y
			oTablePt = ThisApplication.TransientGeometry.CreatePoint2d(.9525, oHeightCustomTable + .9525)
			oCustomTable.Position = oTablePt
		Else If oCustomTable.Rows.Count > oListComp.Count Then
		For i = oCustomTable.Rows.Count To oListComp.Count + 1 Step -1
			oCustomTable.Rows.Item(i).Delete()
		Next i
		oHeightCustomTable = oCustomTable.RangeBox.MaxPoint.Y - oCustomTable.RangeBox.MinPoint.Y
		oTablePt = ThisApplication.TransientGeometry.CreatePoint2d(.9525, oHeightCustomTable + .9525)
		oCustomTable.Position = oTablePt
	End If
	End If
	Dim iList As Long = 1
	For Each Item In oListComp
		oCustomTable.Rows.Item(iList).Item(1).Value = iList
		oCustomTable.Rows.Item(iList).Item(2).Value = Item.Key.Substring(0, Item.Key.IndexOf("X:\"))
		oCustomTable.Rows.Item(iList).Item(3).Value = Item.Value
		oCustomTable.Rows.Item(iList).Item(4).Value = Item.Key.Remove(0, Item.Key.IndexOf("X:\"))
		iList += 1
	Next
End Function

 

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