Sorry for the long post, but here is EVERYTHING!!!, because I'm lazy! Enjoy!
Friend Sub UserRenumberPurchasedParts()
Dim strPrefix As String = InputBox("Enter Item prefix:", "Renumber Purchased Parts", "P")
GetInventorApplication()
If invApp.ActiveDocument IsNot Nothing Then
If TypeOf invApp.ActiveDocument Is Inventor.DrawingDocument Then
Dim drawDoc As DrawingDocument = invApp.ActiveDocument
Dim sheet As Sheet = drawDoc.ActiveSheet
If sheet IsNot Nothing Then
Dim plPurchasedParts As PartsList = Nothing
For Each item As Object In drawDoc.SelectSet
If TypeOf item Is Inventor.PartsList Then
plPurchasedParts = item
Exit For
End If
Next
If plPurchasedParts Is Nothing Then
For Each pl As PartsList In sheet.PartsLists
If pl.Style.Name = "Purchased Parts" Then
plPurchasedParts = pl
Exit For
End If
Next
End If
Dim nextItem As Integer = 1
For j As Integer = 1 To plPurchasedParts.PartsListRows.Count
Dim plRow As PartsListRow = plPurchasedParts.PartsListRows.Item(j)
'renumber the purchased parts items using the P numbers
If plRow.Visible = True Then
For i As Integer = 1 To plRow.Count
Dim plCell As PartsListCell = plRow(i)
Dim plColumn As PartsListColumn = plCell.Parent.PartsListColumns(i)
If plColumn.Title.ToUpper = "ITEM" Then
plCell.Value = strPrefix & nextItem
nextItem += 1
Exit For
End If
Next
End If
Next
Exit Sub
End If
End If
End If
End Sub
Public Sub UserAddPartsLists()
GetInventorApplication()
If invApp.ActiveDocument IsNot Nothing Then
If TypeOf invApp.ActiveDocument Is Inventor.DrawingDocument Then
Dim drawDoc As DrawingDocument = invApp.ActiveDocument
Dim sheet1 As Sheet = drawDoc.ActiveSheet
If sheet1 IsNot Nothing Then
Dim drView As DrawingView = Nothing
For Each item As Object In drawDoc.SelectSet
If TypeOf item Is Inventor.DrawingView Then
drView = item
Exit For
End If
Next
Dim modelDoc As Inventor.Document = Nothing
If drView Is Nothing Then
For Each view As DrawingView In sheet1.DrawingViews
If view.ReferencedDocumentDescriptor IsNot Nothing Then
modelDoc = view.ReferencedDocumentDescriptor.ReferencedDocument
Exit For
End If
Next
Else
If drView.ReferencedDocumentDescriptor IsNot Nothing Then
modelDoc = drView.ReferencedDocumentDescriptor.ReferencedDocument
End If
End If
If modelDoc IsNot Nothing Then
'turn on parts list
Dim pntPartsList As Point2d = invApp.TransientGeometry.CreatePoint2d(sheet1.Width - (0.25 * 2.54), 2.95 * 2.54)
Dim plBOM As PartsList = sheet1.PartsLists.Add(modelDoc, pntPartsList, PartsListLevelEnum.kStructuredAllLevels)
Dim plStyle As PartsListStyle = drawDoc.StylesManager.PartsListStyles.Item("BOM LIST")
plBOM.Style = plStyle
plBOM.Sort2("PART NUMBER", True,,,,, True, False)
Dim booAddPurchasedPartsList As Boolean = False
For Each plRow As PartsListRow In plBOM.PartsListRows
If PlaceInListOfParts(plRow) = False Then
plRow.Visible = False
booAddPurchasedPartsList = True
End If
Next
SortListOfPartsByDocumentType(plBOM)
Dim pMin As Point2d = plBOM.RangeBox.MinPoint
Dim pMax As Point2d = plBOM.RangeBox.MaxPoint
pntPartsList.X += 0
pntPartsList.Y += (pMax.Y - pMin.Y)
plBOM.Position = pntPartsList
'turn on purchased parts list
If booAddPurchasedPartsList Then
pntPartsList = invApp.TransientGeometry.CreatePoint2d(plBOM.Position.X, plBOM.Position.Y)
Dim plPurchasedParts As PartsList = sheet1.PartsLists.Add(modelDoc, pntPartsList, PartsListLevelEnum.kStructuredAllLevels)
plStyle = drawDoc.StylesManager.PartsListStyles.Item("Purchased Parts")
plPurchasedParts.Style = plStyle
plPurchasedParts.Sort2("TITLE", True,,,,, True, False)
Dim nextItem As Integer = 1
For Each plRow As PartsListRow In plPurchasedParts.PartsListRows
Dim strPartNumber As String = String.Empty
'look for part number to see if it is an engineered part, if not turn it off
If PlaceInListOfParts(plRow) = True Then
plRow.Visible = False
Else
'strPartNumber = GetPartNumberFromPartsListRow(plRow)
For i As Integer = 1 To plRow.Count
Dim plCell As PartsListCell = plRow(i)
Dim plColumn As PartsListColumn = plCell.Parent.PartsListColumns(i)
If plColumn.Title.ToUpper = "PART NUMBER" Then
strPartNumber = plCell.Value
If strPartNumber.Contains("ANSI") Then 'if it is not an engineered part , check for ANSI and remove it from this cell
plCell.Value = ""
End If
End If
Exit For
Next
End If
'look for title, and use the previously found part number to see if it has ANSI in the name, if so, move the value from the part number to the title
If strPartNumber.Contains("ANSI") Then
For i As Integer = 1 To plRow.Count
Dim plCell As PartsListCell = plRow(i)
Dim plColumn As PartsListColumn = plCell.Parent.PartsListColumns(i)
If plColumn.Title.ToUpper = "TITLE" Then
If String.IsNullOrWhiteSpace(plCell.Value) Then plCell.Value = strPartNumber
End If
Next
End If
'renumber the purchased parts items using the P numbers
If plRow.Visible = True Then
For i As Integer = 1 To plRow.Count
Dim plCell As PartsListCell = plRow(i)
Dim plColumn As PartsListColumn = plCell.Parent.PartsListColumns(i)
If plColumn.Title.ToUpper = "ITEM" Then
plCell.Value = "P" & nextItem
nextItem += 1
End If
Next
End If
Next
pMin = plPurchasedParts.RangeBox.MinPoint
pMax = plPurchasedParts.RangeBox.MaxPoint
pntPartsList.X += 0
pntPartsList.Y += (pMax.Y - pMin.Y)
plPurchasedParts.Position = pntPartsList
End If
Else
MsgBox("Can not find model for parts list.")
End If
End If
End If
End If
End Sub
Private Sub SortListOfPartsByDocumentType(plBOM As PartsList)
Dim i As Integer = 0
Do
i += 1
Dim booRestart As Boolean = False
Dim pn1 As PartNumber = New PartNumber(GetPartNumberFromPartsListRow(plBOM.PartsListRows(i)))
SetSortOverridesForPartsListRow(plBOM.PartsListRows(i), pn1)
Dim pn2 As PartNumber = New PartNumber(GetPartNumberFromPartsListRow(plBOM.PartsListRows(i + 1)))
SetSortOverridesForPartsListRow(plBOM.PartsListRows(i + 1), pn2)
Dim comp As Integer = pn1.CompareTo(pn2)
If comp = 1 Then
plBOM.PartsListRows(i + 1).Reposition(i)
i = 0
booRestart = True
End If
Loop Until i = plBOM.PartsListRows.Count - 1
End Sub
Private Sub SetSortOverridesForPartsListRow(plRow As PartsListRow, pn As PartNumber)
If plRow.ReferencedFiles.Count > 0 Then
'car file
If plRow.ReferencedFiles.Item(1).FullFileName.Contains("\Libraries\Cars\") Then
pn.SortOverride = -2
End If
'load file
Dim invDoc As Inventor.Document = plRow.ReferencedFiles.Item(1).ReferencedDocument
If GetiPropertyValue(Tools.UserDefinedPropertySetID, "Specification", invDoc) IsNot Nothing Then
pn.SortOverride = -1
End If
End If
End Sub
Jamie Johnson : Owner / Sisu Lissom, LLC https://sisulissom.com/
