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

Just recovered this from google cache:

 

Sub Main()
	If Not ThisApplication.ActiveDocument.DocumentType = DocumentTypeEnum.kDrawingDocumentObject Then
		Messagebox.Show("Current document is not drawing docuemnt", "Inventor")
		Exit Sub
	End If
	Dim value_List As List(Of String) = New List(Of String)

	value_List.Add(iProperties.Value("Project", "Vendor"))
	value_List.Add( iProperties.Value("Project", "Stock Number"))
	value_List.Add(iProperties.Value("Project", "Project"))
	value_List.Add(iProperties.Value("Project", "Designer"))

	Dim oDoc As Document
	oDoc = ThisDrawing.ModelDocument 

	If oDoc.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then
		
		Update_Properties(oDoc,  value_List)
		
		Dim oAsyDoc As AssemblyDocument 
		oAsyDoc = oDoc
		 
		Dim oReferDoc As Document 
		Dim occ As ComponentOccurrence 
		Dim oDef As AssemblyComponentDefinition 
		oDef = oAsyDoc.ComponentDefinition  

		For Each occ In oDef.Occurrences 			
			If occ.SubOccurrences.Count = 0 Then
				oReferDoc = occ.ReferencedDocumentDescriptor.ReferencedDocument
				Update_Properties(oReferDoc, value_List)
			Else				
				oReferDoc = occ.ReferencedDocumentDescriptor.ReferencedDocument
				Update_Properties(oReferDoc,   value_List)
				processAllSubOcc(occ,  value_List)
			End If				
		Next 
		
	Else If oDoc.DocumentType = DocumentTypeEnum.kPartDocumentObject Then
		Update_Properties(oDoc, value_List)
	End If 

End Sub 

Private Sub processAllSubOcc(ByVal oCompOcc As ComponentOccurrence , value_List As List(Of String))
    
	Dim oSubCompOcc As ComponentOccurrence
	Dim oReferDoc As Document 
    For Each oSubCompOcc In oCompOcc.SubOccurrences
        If oSubCompOcc.SubOccurrences.Count = 0 Then
            oReferDoc = oSubCompOcc.ReferencedDocumentDescriptor.ReferencedDocument
			Update_Properties(oReferDoc,value_List)			
        Else
            oReferDoc = oSubCompOcc.ReferencedDocumentDescriptor.ReferencedDocument
			Update_Properties(oReferDoc ,value_List)			
            Call processAllSubOcc(oSubCompOcc, value_List)
        End If
    Next
	
End Sub

Sub Update_Properties(oDoc As Document,   value_List As List(Of String))
	
	oDoc.PropertySets.Item("Design Tracking Properties").Item("Vendor").Value = value_List.Item(0)
	oDoc.PropertySets.Item("Design Tracking Properties").Item("Stock Number").Value = value_List.Item(1)
	oDoc.PropertySets.Item("Design Tracking Properties").Item("Project").Value = value_List.Item(2)
	oDoc.PropertySets.Item("Design Tracking Properties").Item("Designer").Value = value_List.Item(3)	 
	oDoc.Save()
	
End Sub