09-25-2023
02:24 PM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
09-25-2023
02:24 PM
@WCrihfield Yes Below is the full code. I can look into using the all referenced components. If I used the all referenced components would it also take include any of the files that the bom structure is set to reference? We do use reference a lot and the iLogic I have right now doesn't include the reference files which I want to keep that way. I'm sure I could set it to exclude any with the bom structure of reference.
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 oBOM As BOM = oAssDoc.ComponentDefinition.BOM
Dim oBOMView As BOMView = GetBOMstructure(oBOM)
If oBOMView Is Nothing Then Exit Sub
Dim oListComp As Object = CreateObject("Scripting.Dictionary")
Call GetListComponents(oBOMView.BOMRows, 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 GetBOMstructure(ByVal oBOM As BOM) As BOMView
Dim sLanguageBOM, sSortItem As String
Select Case ThisApplication.LanguageCode
Case "en-US"
sLanguageBOM = "Structured"
Case Else
Return Nothing
End Select
If oBOM.StructuredViewEnabled = False Then oBOM.StructuredViewEnabled = True
If oBOM.StructuredViewFirstLevelOnly = True Then oBOM.StructuredViewFirstLevelOnly = False
Return oBOM.BOMViews.Item(sLanguageBOM)
End Function
Private Function GetListComponents(ByVal oBOMRows As BOMRowsEnumerator, ByRef oListComp As Object)
Dim oCompDef As ComponentDefinition
For Each oRow As BOMRow In oBOMRows
oCompDef = oRow.ComponentDefinitions.Item(1)
Dim oDoc As Document = oCompDef.Document
If oDoc.PropertySets.Item("Design Tracking Properties").Item("Cost Center").Value = "ACC" Then
Dim sStokNumb As String = oDoc.PropertySets.Item("Design Tracking Properties").Item("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 FilePath As String = "X:\7 - Design\0 - Batch Plot Drawings\" + Folder_Location.Substring(16)
Dim NewFilePath As String = FilePath + "\"
'i = MessageBox.Show("The Value you entered was incorrect " & NewFilePath, "My iLogic Dialog", MessageBoxButtons.OK, MessageBoxIcon.Hand, MessageBoxDefaultButton.Button1)
'Used if folder isn't in right location
If Not oListComp(sStokNumb + NewFilePath).exists(sStokNumb) Then
oRow = oRow + oRow.ItemQuantity
' oListComp(sStokNumb + NewFilePath).add.oRow.ItemQuanity
Else
oListComp(sStokNumb + NewFilePath) = oListComp(sStokNumb + NewFilePath) + oRow.ItemQuantity
End If
End If
If oRow.ChildRows IsNot Nothing Then
GetListComponents(oRow.ChildRows, oListComp)
End If
Next
End Function
Private Function CreatTable(ByVal oSheet As Sheet, ByVal oListComp As Object, 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.Substring(0, Item.IndexOf("X:\"))
oCustomTable.Rows.Item(iList).Item(3).Value = oListComp(Item)
oCustomTable.Rows.Item(iList).Item(4).Value = Item.Remove(0, Item.IndexOf("X:\"))
iList += 1
Next
End Function