How to send iProperties to all parts of Assembly and his Sub-Assemblies

Anonymous · ‎05-10-2018

The code below is sending some iproperties to the different parts of the assembly, now I have placed some sub-assemblies as well but the code is not taking in consideration the parts of those sub-assemblies to send the iproperties, can somebody help me to correct the code so it does that as well. basically to send the iproperties in the code to all parts in the assembly and to all the parts of the different sub-assemblies as well.

Thanks in advance

Here is the code:

SyntaxEditor Code Snippet

Dim oAsmCompDef As AssemblyComponentDefinition
oAsmCompDef = ThisApplication.ActiveDocument.ComponentDefinition
'Iterate through all Of the occurrences
Dim oOccurrence As ComponentOccurrence
For Each oOccurrence In oAsmCompDef.Occurrences.AllReferencedOccurrences(oAsmCompDef)
Try
'write to component iprops
iProperties.Value(oOccurrence, "Project", "Project") = iProperties.Value("Project", "Project")
iProperties.Value(oOccurrence, "Project", "Creation Date") = iProperties.Value("Project", "Creation Date")
iProperties.Value(oOccurrence, "Summary", "Title") = iProperties.Value("Summary", "Title")
iProperties.Value(oOccurrence, "Summary", "Company") = iProperties.Value("Summary", "Company")
iProperties.Value(oOccurrence, "Summary", "Author") = iProperties.Value("Summary", "Author")
iProperties.Value(oOccurrence, "Custom", "AVT_NUMBER") = iProperties.Value("Custom", "AVT_NUMBER")
Catch 'catch errors
	MsgBox ("ERROR WHEN MAKING LABEL")
End Try
Next

bradeneuropeArthur · ‎05-10-2018

If the component is an assembly the code selves need to be run again. Can you upload the complete code with the routine name so we can modify it for you...

Regards,

Arthur Knoors

Autodesk Affiliations & Links:

MechMachineMan · ‎05-10-2018

Dim oAsmCompDef As AssemblyComponentDefinition
oAsmCompDef = ThisApplication.ActiveDocument.ComponentDefinition
'Iterate through all Of the occurrences
Dim oOccurrence As ComponentOccurrence
For Each oOccurrence In oAsmCompDef.Occurrences.AllLeafOccurrences
    Try
    'write to component iprops
        iProperties.Value(oOccurrence, "Project", "Project") = iProperties.Value("Project", "Project")
        iProperties.Value(oOccurrence, "Project", "Creation Date") = iProperties.Value("Project", "Creation Date")
        iProperties.Value(oOccurrence, "Summary", "Title") = iProperties.Value("Summary", "Title")
        iProperties.Value(oOccurrence, "Summary", "Company") = iProperties.Value("Summary", "Company")
        iProperties.Value(oOccurrence, "Summary", "Author") = iProperties.Value("Summary", "Author")
        iProperties.Value(oOccurrence, "Custom", "AVT_NUMBER") = iProperties.Value("Custom", "AVT_NUMBER")
    Catch 'catch errors
	MsgBox ("ERROR WHEN MAKING LABEL FOR:" & vblf & oOccurrence.Name)
    End Try
Next

--------------------------------------
Did you find this reply helpful ? If so please use the 'Accept as Solution' or 'Like' button below.

Justin K
Inventor 2018.2.3, Build 227 | Excel 2013+ VBA
ERP/CAD Communication | Custom Scripting
Machine Design | Process Optimization

iLogic/Inventor API: Autodesk Online Help | API Shortcut In Google Chrome | iLogic API Documentation
Vb.Net/VBA Programming: MSDN | Stackoverflow | Excel Object Model
Inventor API/VBA/Vb.Net Learning Resources: Forum Thread

Sample Solutions:Debugging in iLogic ( and Batch PDF Export Sample ) | API HasSaveCopyAs Issues |
BOM Export & Column Reorder | Reorient Skewed Part | Add Internal Profile Dogbones |
Run iLogic From VBA | Batch File Renaming| Continuous Pick/Rename Objects

Local Help: %PUBLIC%\Documents\Autodesk\Inventor 2018\Local Help

Ideas: Dockable/Customizable Property Browser | Section Line API/Thread Feature in Assembly/PartsList API Static Cells | Fourth BOM Type

Anonymous · ‎05-11-2018

I'll try to upload the model as soon as I can, I really appreciate all of your inputs

Anonymous · ‎06-21-2018

I got a more detailed code where everything is well passing from the model properties to his parts custom properties, sadly still not passing to the model sub-assemblies custom properties.

Could you please see how to make it work. Really appreciate your help.

SyntaxEditor Code Snippet

Sub Main
'Gets the Active Document
oDoc = ThisDoc.Document

'Saves this document
oDoc.Save

'Checks if the active document is an assembly
If oDoc.DocumentType = kAssemblyDocumentObject
	'Gets the assembly occurrences
	Dim oOccs As ComponentOccurrences
	oOccs = oDoc.ComponentDefinition.Occurrences
	'Call the subprocedure to traverse the assembly
	Call TraverseAssembly(oOccs)
End If

End Sub

'***************
Public Sub TraverseAssembly(oOccs As ComponentOccurrences)
 'Integer to traverse the assembly occurrences
 Dim i As Integer
 
 For i=1 To oOccs.Count
  Dim oOcc As ComponentOccurrence
  oOcc = oOccs.Item(i)
  
 	If oOcc.Suppressed = False
   
		'Occurrence Name (Display Name)
		oOccName = oOcc.Name
		
		'Gets the first three leters of the Occurrence Name (e.g. "STK")
		oOccPrefix = Left(oOccName, 3)
		
		If oOccPrefix <> "STK"
		
			Try
				iProperties.Value(oOccName, "Project", "Project") = iProperties.Value("Project", "Project")
				iProperties.Value(oOccName, "Project", "Creation Date") = iProperties.Value("Project", "Creation Date")		
				iProperties.Value(oOccName, "Summary", "Title") = iProperties.Value("Summary", "Title")
				iProperties.Value(oOccName, "Summary", "Company") = iProperties.Value("Summary", "Company")
				iProperties.Value(oOccName, "Summary", "Author") = iProperties.Value("Summary", "Author")
				iProperties.Value(oOccName, "Custom", "AVT_NUMBER") = iProperties.Value("Custom", "AVT_NUMBER")
				iProperties.Value(oOccName, "Custom", "CAR_NUMBER") = iProperties.Value("Custom", "CAR_NUMBER")
				iProperties.Value(oOccName, "Custom", "JOB_NAME") = iProperties.Value("Custom", "JOB_NAME")
				iProperties.Value(oOccName, "Custom", "ToPrint_AVT_NUMBER") = iProperties.Value("Custom", "ToPrint_AVT_NUMBER")
				iProperties.Value(oOccName, "Custom", "ToPrint_CAR_NUMBER") = iProperties.Value("Custom", "ToPrint_CAR_NUMBER")
				iProperties.Value(oOccName, "Custom", "ToPrint_JOB_NAME") = iProperties.Value("Custom", "ToPrint_JOB_NAME")
				iProperties.Value(oOccName, "Custom", "Path_Amada") = iProperties.Value("Custom", "Path_Amada")
				iProperties.Value(oOccName, "Custom", "Path_Laser") = iProperties.Value("Custom", "Path_Laser")
			
				
			Catch
				'It won't be able to change Read-Only parts (e.g. Content Center)
				'MessageBox.Show("This is a content center file: " & oOcc.Name, "Title")
			End Try
		End If

		If oOcc.DefinitionDocumentType = kAssemblyDocumentObject
			Call TraverseAssembly(oOcc.SubOccurrences)
		End If
	End If
Next
End Sub

Anonymous · ‎06-21-2018

sorry it took so long... I was doing other things,

Now I have a code that is passing the main assembly custom properties to the parts, but not to the sub-assembly custom properties,

Can you help me with this? thanks,

Sub Main
'Gets the Active Document
oDoc = ThisDoc.Document

'Saves this document
oDoc.Save

'Checks if the active document is an assembly
If oDoc.DocumentType = kAssemblyDocumentObject
	'Gets the assembly occurrences
	Dim oOccs As ComponentOccurrences
	oOccs = oDoc.ComponentDefinition.Occurrences
	'Call the subprocedure to traverse the assembly
	Call TraverseAssembly(oOccs)
End If

End Sub

'***************
Public Sub TraverseAssembly(oOccs As ComponentOccurrences)
 'Integer to traverse the assembly occurrences
 Dim i As Integer
 
 For i=1 To oOccs.Count
  Dim oOcc As ComponentOccurrence
  oOcc = oOccs.Item(i)
  
 	If oOcc.Suppressed = False
   
		'Occurrence Name (Display Name)
		oOccName = oOcc.Name
		
		'Gets the first three leters of the Occurrence Name (e.g. "STK")
		oOccPrefix = Left(oOccName, 3)
		
		If oOccPrefix <> "STK"
		
			Try
				iProperties.Value(oOccName, "Project", "Project") = iProperties.Value("Project", "Project")
				iProperties.Value(oOccName, "Project", "Creation Date") = iProperties.Value("Project", "Creation Date")		
				iProperties.Value(oOccName, "Summary", "Title") = iProperties.Value("Summary", "Title")
				iProperties.Value(oOccName, "Summary", "Company") = iProperties.Value("Summary", "Company")
				iProperties.Value(oOccName, "Summary", "Author") = iProperties.Value("Summary", "Author")
				iProperties.Value(oOccName, "Custom", "AVT_NUMBER") = iProperties.Value("Custom", "AVT_NUMBER")
				iProperties.Value(oOccName, "Custom", "CAR_NUMBER") = iProperties.Value("Custom", "CAR_NUMBER")
				iProperties.Value(oOccName, "Custom", "JOB_NAME") = iProperties.Value("Custom", "JOB_NAME")
				iProperties.Value(oOccName, "Custom", "ToPrint_AVT_NUMBER") = iProperties.Value("Custom", "ToPrint_AVT_NUMBER")
				iProperties.Value(oOccName, "Custom", "ToPrint_CAR_NUMBER") = iProperties.Value("Custom", "ToPrint_CAR_NUMBER")
				iProperties.Value(oOccName, "Custom", "ToPrint_JOB_NAME") = iProperties.Value("Custom", "ToPrint_JOB_NAME")
				iProperties.Value(oOccName, "Custom", "Path_Amada") = iProperties.Value("Custom", "Path_Amada")
				iProperties.Value(oOccName, "Custom", "Path_Laser") = iProperties.Value("Custom", "Path_Laser")
			
				
			Catch
				'It won't be able to change Read-Only parts (e.g. Content Center)
				'MessageBox.Show("This is a content center file: " & oOcc.Name, "Title")
			End Try
		End If

		If oOcc.DefinitionDocumentType = kAssemblyDocumentObject
			Call TraverseAssembly(oOcc.SubOccurrences)
		End If
	End If
Next
End Sub

bradeneuropeArthur · ‎06-21-2018

Sub Main
'Gets the Active Document
oDoc = ThisDoc.Document

'Saves this document
oDoc.Save

'Checks if the active document is an assembly
If oDoc.DocumentType = kAssemblyDocumentObject
	'Gets the assembly occurrences
	Dim oOccs As ComponentOccurrences
	oOccs = oDoc.ComponentDefinition.Occurrences
	'Call the subprocedure to traverse the assembly
	Call TraverseAssembly(oOccs)
End If

End Sub

'***************
Public Sub TraverseAssembly(oOccs As ComponentOccurrences)
 'Integer to traverse the assembly occurrences
 Dim i As Integer
 
 'For i=1 To oOccs.Count
  Dim oOcc As ComponentOccurrence
For Each oOcc in oOccs
  'oOcc = oOccs.Item(i)  
 	If oOcc.Suppressed = False
   
		'Occurrence Name (Display Name)
		oOccName = oOcc.Name
		
		'Gets the first three leters of the Occurrence Name (e.g. "STK")
		oOccPrefix = Left(oOccName, 3)
		
		If oOccPrefix <> "STK"
		
			Try
				iProperties.Value(oOccName, "Project", "Project") = iProperties.Value("Project", "Project")
				iProperties.Value(oOccName, "Project", "Creation Date") = iProperties.Value("Project", "Creation Date")		
				iProperties.Value(oOccName, "Summary", "Title") = iProperties.Value("Summary", "Title")
				iProperties.Value(oOccName, "Summary", "Company") = iProperties.Value("Summary", "Company")
				iProperties.Value(oOccName, "Summary", "Author") = iProperties.Value("Summary", "Author")
				iProperties.Value(oOccName, "Custom", "AVT_NUMBER") = iProperties.Value("Custom", "AVT_NUMBER")
				iProperties.Value(oOccName, "Custom", "CAR_NUMBER") = iProperties.Value("Custom", "CAR_NUMBER")
				iProperties.Value(oOccName, "Custom", "JOB_NAME") = iProperties.Value("Custom", "JOB_NAME")
				iProperties.Value(oOccName, "Custom", "ToPrint_AVT_NUMBER") = iProperties.Value("Custom", "ToPrint_AVT_NUMBER")
				iProperties.Value(oOccName, "Custom", "ToPrint_CAR_NUMBER") = iProperties.Value("Custom", "ToPrint_CAR_NUMBER")
				iProperties.Value(oOccName, "Custom", "ToPrint_JOB_NAME") = iProperties.Value("Custom", "ToPrint_JOB_NAME")
				iProperties.Value(oOccName, "Custom", "Path_Amada") = iProperties.Value("Custom", "Path_Amada")
				iProperties.Value(oOccName, "Custom", "Path_Laser") = iProperties.Value("Custom", "Path_Laser")
			
				
			Catch
				'It won't be able to change Read-Only parts (e.g. Content Center)
				'MessageBox.Show("This is a content center file: " & oOcc.Name, "Title")
			End Try
		End If

		If oOcc.DefinitionDocumentType = kAssemblyDocumentObject
			Call TraverseAssembly(oOcc.SubOccurrences)
		End If
	End If
Next
End Sub

Regards,

Arthur Knoors

Autodesk Affiliations & Links:

Anonymous · ‎06-21-2018

Big thanks!!!

It worked perfectly well.

bradeneuropeArthur · ‎06-21-2018

Hi,

Your thanks are appreciated very much.

Regards,

Autodesk Software: Inventor Professional 2018 | Vault Professional 2018 | Autocad Mechanical 2018
Programming Skills: Vba | Vb.net (Add ins Vault / Inventor, Applications) | I-logic
Dimension Component! | Partlist Export! | Derive I-properties! | Vault Prompts Via API! | Vault Handbook/Manual!
Drawing Toggle Sheets! | Vault Defer Update!

! For administrative reasons, please mark a "Solution as solved" when the issue is solved !

Regards,

Arthur Knoors

Autodesk Affiliations & Links:

Community

How to send iProperties to all parts of Assembly and his Sub-Assemblies

How to send iProperties to all parts of Assembly and his Sub-Assemblies

How to send iProperties to all parts of Assembly and his Sub-Assemblies