Insert parent name to custom property of children.

[peterjoachim]

I am trying to run a rule from an assembly to insert the parent name of each component to a custom property. I have this code that does exactly what I'm looking for but it errors out when there are read only parts, such as library parts, in the assembly. Is there a way to ignore read only files in the assembly? Sorry I'm not very good with code.

Sub Main
	
	Dim oAsmCompDef As AssemblyComponentDefinition
	oAsmCompDef = ThisApplication.ActiveDocument.ComponentDefinition
	
	'Iterate through all of the occurrences
	Dim oOccurrence As ComponentOccurrence
	For Each oOccurrence In oAsmCompDef.Occurrences
		
		Call ProcessAllChildren(oOccurrence)
	
	Next

End Sub

Public Sub ProcessAllChildren(ByRef oOccurrence As ComponentOccurrence) 

		' Get the custom property set.
    	Dim invCustomPropertySet As PropertySet
    	invCustomPropertySet = oOccurrence.Definition.Document.PropertySets.Item(​"Inventor User Defined Properties")
		
		Dim invParentCustProp As Inventor.Property
        
		Try
			'If this fails Parent_Name Property does not exist
			invParentCustProp = invCustomPropertySet.Item("UsedInAssy")
			'MessageBox.Show("invParentCustProp Exists" , oOccurrence.Name)

       	Catch
			' Create the property as it did not exist.
			'MessageBox.Show("invParentCustProp Does not Exist" , oOccurrence.Name)
			Try
				' oOccurrence.ParentOccurrence is nothing if it is a top level occurrence
				' ParentOccurence will be the sub assembly the occurrence is in
				Dim filename As String = System.IO.Path.GetFileNameWithoutExtension(oOccurrence.parentOccurrence.Definition.Document.Displayname)
				invCustomPropertySet.Add(filename, "UsedInAssy")
			Catch
				'This works if the occurrence is in the top level assembly
				' oOccurrence.Parent.Document.DisplayName
				Dim filename As String = System.IO.Path.GetFileNameWithoutExtension(oOccurrence.Parent.Document.DisplayName)
				invCustomPropertySet.Add(filename, "UsedInAssy")
			End Try

			invParentCustProp = invCustomPropertySet.Item("UsedInAssy")
   		 
		End Try
		
		'Update the value for the custom property for this occurrence if it does not already have it
		Try
			Dim strExistingVal As String = invParentCustProp.Value
			Dim filename As String = System.IO.Path.GetFileNameWithoutExtension(oOccurrence.ParentOccurrence.Definition.Document.DisplayName)
			If Not strExistingVal.Contains(filename) Then
				' Try to get the ParentOccurrence, this will fail if it is a top level occurrence
				invParentCustProp.Value = strExistingVal & "; " & filename
				'MessageBox.Show("In Try after Occurrence.ParentOccurrence.Definition.Document.Di​splayName" , oOccurrence.ParentOccurrence.Definition.Document.D​isplayName)
			End If
		Catch
			Dim strExistingVal As String = invParentCustProp.Value
			Dim filename As String = System.IO.Path.GetFileNameWithoutExtension(oOccurrence.Parent.Document.DisplayName)
			If Not strExistingVal.Contains(filename) Then
				'This works the top level assembly
				invParentCustProp.Value =  strExistingVal & "; " & filename
			End If
		End Try
	
	Dim oCompOcc As ComponentOccurrence
	Dim oComponentSubOccurrences As ComponentOccurrences
'	
    For Each oCompOcc In oOccurrence.SubOccurrences
      
        If oCompOcc.DefinitionDocumentType = kAssemblyDocumentObject Then
           oComponentSubOccurrences = oCompOcc.SubOccurrences
		   
		   If Not oComponentSubOccurrences Is Nothing Then
			If oComponentSubOccurrences.Count > 0 Then
				ProcessAllChildren(oCompOcc)
			End If
           End If
        Else
            ProcessAllChildren(oCompOcc)
        End If
        
     Next
End Sub

[peterjoachim]

I've discovered it's not an issue with read-only parts. The issue is specifically with library parts. If there is a library part in the assembly it errors. Non-library, read-only parts are fine. Is there a way to ignore library parts?

[peterjoachim · Accepted solution]

Here is the final working code..

Sub Main()
    Dim oDoc As Document
     oDoc = ThisApplication.ActiveDocument
    
    Dim oACD As AssemblyComponentDefinition
    oACD = oDoc.ComponentDefinition
    
    Dim oBOM As BOM
     oBOM = oACD.BOM
    
    Dim oPartsBOM As BOMView
    Dim oStructBOM As BOMView
    
    With oBOM
        .StructuredViewEnabled = True
        .StructuredViewFirstLevelOnly = False
        .StructuredViewDelimiter = "."
         oStructBOM = .BOMViews("Structured")
    End With
    
    Call PurgeNewiProps(oDoc)
    Call AddAncestryViaStruct(oDoc, oStructBOM)

    MsgBox ("Rule complete!" & vbLf & vbLf & "Custom Property Added: Used In Assy" & vbLf & vbLf & "Files with issues: " & vbLf & oLogStr)
    
End Sub

Sub PurgeNewiProps(oDoc)
    For Each oSubDoc In oDoc.AllReferencedDocuments
        If oSubDoc.IsModifiable = True Then
            On Error Resume Next
                oSubDoc.PropertySets("Inventor User Defined Properties").Item("Used In Assy").Value = ""
                oSubDoc.PropertySets("Inventor User Defined Properties").Item("_TotalQTY").Value = ""
        End If
    Next
End Sub

Sub AddAncestryViaStruct(oGADoc As Document, oStructBOM As BOMView)
    Dim oRow As BOMRow
    For Each oRow In oStructBOM.BOMRows
        Call AddAncestryToRow(oRow, oGADoc.PropertySets("Design Tracking Properties")("Part Number").Value, "1")
    Next
End Sub

Sub AddAncestryToChildren(oRow As BOMRow, oParentQTY As String)
    If oRow.ComponentDefinitions.Item(1).Type = ObjectTypeEnum.kVirtualComponentDefinitionObject Then
        Exit Sub
    End If
   
    Dim oPN As String
    oPN = oRow.ComponentDefinitions.Item(1).Document.PropertySets("Design Tracking Properties")("Part Number").Value
    
    Dim oPQTY As String
    oPQTY = oRow.TotalQuantity * CInt(oParentQTY)
    
    Dim oCRow As BOMRow
    For Each oCRow In oRow.ChildRows
        If oCRow.ComponentDefinitions.Item(1).Type <> ObjectTypeEnum.kVirtualComponentDefinitionObject Then
            Call AddAncestryToRow(oCRow, oPN, oPQTY)
        End If
    Next
End Sub

Sub AddAncestryToRow(oCRow As BOMRow, oPN As String, oParentQTY As String)
    Dim oAncestryString As String
    Dim oSubDoc As Document
    Dim oQTY As String
    Dim oiQTY As Integer
    
     oSubDoc = oCRow.ComponentDefinitions(1).Document
    If oSubDoc.IsModifiable = True Then
        On Error Resume Next
            oAncestryString = oSubDoc.PropertySets("Inventor User Defined Properties").Item("Used In Assy").Value
        If Err.Number <> 0 Then
            Call oSubDoc.PropertySets("Inventor User Defined Properties").Add("", "Used In Assy")
            oAncestryString = ""
        End If
        
Dim j As Integer
        For j = 1 To oParentQTY
            oAncestryString = AppendAncestryString(oAncestryString, oPN, oQTY)
        Next
        
        oSubDoc.PropertySets("Inventor User Defined Properties").Item("Used In Assy").Value = oAncestryString
     Else
         oLogStr = oLogStr & vbLf & "NO ANCESTRY ADDED FOR: " & oSubDoc.PropertySets("Design Tracking Properties")("Part Number").Value
     End If

    If Not oCRow.ChildRows Is Nothing Then
        Call AddAncestryToChildren(oCRow, oParentQTY)
    End If
End Sub

Function AppendAncestryString(oAncestryString As String, oPN As String, oQTY As String) As String
      pos = InStr(oAncestryString, oPN)
      If pos = 0 Then
          If Len(oAncestryString) = 0 Then
               oAncestryString = Right(oPN, 3)
          Else
               oAncestryString = oAncestryString & "; " & Right(oPN, 3)
          End If
      Else
      
            openpos = InStr(pos, oAncestryString, "(")
            closepos = InStr(openpos, oAncestryString, ")")
            xpos = InStr(openpos, oAncestryString, "x", vbTextCompare)

            If xpos = 0 Or xpos > closepos Or xpos < openpos Then
                oAncestryString = Left(oAncestryString, openpos) & "2 X " & Right(oAncestryString, Len(oAncestryString) - openpos)
            Else
                oOldQTYx = Trim(Mid(oAncestryString, openpos + 1, xpos - 1 - openpos))
                oNewQTYX = CInt(oOldQTYx) + 1
                oAncestryString = Left(oAncestryString, openpos) & oNewQTYX & Right(oAncestryString, Len(oAncestryString) - xpos + 2)
            End If
      End If
      
      AppendAncestryString = oAncestryString
End Function

Sub AddTotalQTY(oDoc)
    Dim oSubDoc As Document
    For Each oSubDoc In oDoc.AllReferencedDocuments
        If oSubDoc.IsModifiable = True Then
        
            oTotalQTY = GetTotalFromAncestry(oSubDoc.PropertySets("Inventor User Defined Properties")("Used In Assy").Value)
                  
            On Error Resume Next
                oSubDoc.PropertySets("Inventor User Defined Properties").Item("_TotalQTY").Value = oTotalQTY
            If Err.Number <> 0 Then
                Call oSubDoc.PropertySets("Inventor User Defined Properties").Add(oTotalQTY, "_TotalQTY")
            End If
        Else
            oLogStr = oLogStr & vbLf & "NO QTY ADDED: " & oSubDoc.PropertySets("Design Tracking Properties")("Part Number").Value
        End If
    Next
End Sub

Function GetTotalFromAncestry(oStr As String) As Integer
    Dim openpos As Integer
    openpos = 1
    
    Dim multiplier As Integer
    Dim qty As Integer
    Dim runningtotal As Integer
    
    Do Until oStr = ""
        openpos = InStr(1, oStr, "(")
        closepos = InStr(openpos, oStr, ")")
        xpos = InStr(openpos, oStr, "x", vbTextCompare)
        
        If xpos = 0 Or xpos > closepos Or xpos < openpos Then
            thistotal = Trim(Mid(oStr, openpos + 1, closepos - openpos - 1))
        Else
            multiplier = Trim(Mid(oStr, openpos + 1, xpos - 1 - openpos))
            qty = Trim(Mid(oStr, xpos + 1, closepos - 1 - xpos))
            thistotal = multiplier * qty
            
        End If
        runningtotal = runningtotal + thistotal
        oStr = Right(oStr, Len(oStr) - closepos)
    Loop
    GetTotalFromAncestry = runningtotal
End Function