ilogic to change subassembly iProperty description

[clamuro-IPEC]

I found a somewhat similar post about adding a custom iProperty value to a selection set and I would like to try to modify it to author the iProperty description field with the sub-assembly's occurrence name.  I have tried to adapt the attached code but can't seem to make anything happen.

For instance, I want the 52101-037-2 1/2"-PP14-S53-H2 (which is a user modified occurrence name) to be copied to the description for that sub-assembly.

Here is the code I found:

Sub Main()
   Dim oDoc As Document
   oDoc = ThisApplication.ActiveDocument
   Dim comps As SelectSet
   Dim comp As ComponentOccurrence
   comps = oDoc.SelectSet
   'If there are selected components we can do something, otherwise we're done
   If comps.count = 0 Then Exit Sub
   Dim aDoc As DocumentsEnumerator
   aDoc = oDoc.AllReferencedDocuments
   Dim iDoc As Document
   Dim cName As String
   Dim cTS As String
   Dim sTS As String
   Dim FNP As Long
   Dim cFNP As Long
   Dim docFN As String
   For Each iDoc In aDoc
      sTS = iDoc.FullFileName
      FNP = InStrRev(sTS, "\", - 1)
      docFN = Mid(sTS, FNP + 1, Len(sTS) - FNP)
      For Each comp In comps
         cTS = comp.Name
         cFNP = InStrRev(cTS, ":", - 1)
	     cName = Left(cTS, cFNP - 1)
         If cName = Left(docFN, Len(docFN)-4) Then
            'Set iProperty in each of the selected parts in assembly
            iProperties.Value(docFN, "Custom", "Mark") = "this part is now marked"
         End If
      Next
   Next
End Sub

[MechMachineMan]

Sure, it should work just fine. Just be aware that a document can only have 1 set of properties, but can be used as multiple occurrences.

Something like this below should be close. Note, it should only be run once per set of files or else it will be adding info to the end of the description (Things you need to think about how you will handle at the outset of a project).

Sub Main()
   Dim oDoc As Document
   oDoc = ThisApplication.ActiveDocument
   
   Dim oAsmDef as AssemblyComponentDefinition
   oAsmDef = oDoc.ComponentDefinition

   
   Dim oSubDoc as Document   

   For Each oSubDoc In oDoc.AllReferencedDocuments
       oOccName = oAsmDef.Occurrences.AllReferencedOccurrences(oSubDoc).Item(1).Name
       pos = InStrRev(oOccName, ":", - 1) - 1
       cName = Left(oOccName, pos)

       oDescripProp = oSubDoc.PropertySet("Design Tracking Properties")("Description")
       oDescripProp.Value = oDescripProp.Value & cName
    Next
End Sub

[clamuro-IPEC]

Thanks for the response @MechMachineMan.  These assemblies are all unique so the description iProperty won't conflict with other occurrences.  This code will be run at the end of the project so it should only need to be used once per project.

I am getting an error when running it. 

[MechMachineMan · Accepted solution]

Here is a more thorough version with undo functionality:

Sub Main()
	Dim oDoc As Document
	oDoc = ThisApplication.ActiveDocument

    Dim oTransMgr As TransactionManager
	oTransMgr = ThisApplication.TransactionManager
	oTrans = oTransMgr.StartTransaction(oDoc, "Rule - Append Description")
	
	Dim oAsmDef As AssemblyComponentDefinition
	oAsmDef = oDoc.ComponentDefinition
   

	Dim oSubDoc As Document   
	Dim oOccName As String
	Dim pos As Integer
	Dim cName As String
	Dim oDescripProp As Inventor.Property
	
	For Each oSubDoc In oDoc.AllReferencedDocuments
		Try
			If oSubDoc.isModifiable = True
				oOccSet = oAsmDef.Occurrences.AllReferencedOccurrences(oSubDoc)
				If oOccSet.Count <> 0 Then
					oOccName = oOccSet.Item(1).Name
					pos = InStrRev(oOccName, ":", - 1) - 1
					
					If pos = - 1 Then
						cName = oOccName
					Else
						cName = Left(oOccName, pos)
					End If
					
					oDescripProp = oSubDoc.PropertySets("Design Tracking Properties")("Description")
					
					oDescripProp.Value = oDescripProp.Value & " " & cName
				Else
					MsgBox("Referenced Doc (likely a derived part source) not found: " & vbLf & vbLf & oSubDoc.FullFileName & vbLf & vbLf & "Description for this file not modified.")
				End If
			End If
		Catch
			MsgBox("Error with " & oSubDoc.FullFileName)
			oTrans.Abort
			Exit Sub
		End Try
	Next
	
	oTrans.End
End Sub

[clamuro-IPEC]

Thanks!  It works...  a little too well.  It is also adding the occurrence name to child parts of the subassemblies instead of just the subassembly.

[MechMachineMan · Accepted solution]

The version that will only change the top level components' description iProperty:

Note: It may grab the occurrence name from the instance of a part in a sub-assembly in the case that the part exists in both the top level and within a sub-assembly. Hopefully these cases are minimal and the rule with this minor tweak is fine for you.

Sub Main()
	Dim oDoc As Document
	oDoc = ThisApplication.ActiveDocument

    Dim oTransMgr As TransactionManager
	oTransMgr = ThisApplication.TransactionManager
	oTrans = oTransMgr.StartTransaction(oDoc, "Rule - Append Description")
	
	Dim oAsmDef As AssemblyComponentDefinition
	oAsmDef = oDoc.ComponentDefinition
   

	Dim oSubDoc As Document   
	Dim oOccName As String
	Dim pos As Integer
	Dim cName As String
	Dim oDescripProp As Inventor.Property
	
'	For Each oSubDoc In oDoc.AllReferencedDocuments
        For Each oSubDoc in oDoc.ReferencedDocuments
		Try
			If oSubDoc.isModifiable = True
				oOccSet = oAsmDef.Occurrences.AllReferencedOccurrences(oSubDoc)
				If oOccSet.Count <> 0 Then
					oOccName = oOccSet.Item(1).Name
					pos = InStrRev(oOccName, ":", - 1) - 1
					
					If pos = - 1 Then
						cName = oOccName
					Else
						cName = Left(oOccName, pos)
					End If
					
					oDescripProp = oSubDoc.PropertySets("Design Tracking Properties")("Description")
					
					oDescripProp.Value = oDescripProp.Value & " " & cName
				Else
					MsgBox("Referenced Doc (likely a derived part source) not found: " & vbLf & vbLf & oSubDoc.FullFileName & vbLf & vbLf & "Description for this file not modified.")
				End If
			End If
		Catch
			MsgBox("Error with " & oSubDoc.FullFileName)
			oTrans.Abort
			Exit Sub
		End Try
	Next
	
	oTrans.End
End Sub