UCS constraint - Works only in the last item

[Anonymous]

I dont know why the code works only in the last item.

Pls see attached files. 

Thank you in advance.

Dim oSubAsm As AssemblyDocument = ThisAssembly.Document
Dim wfUCSs As UserCoordinateSystems
Dim wfDoc As PartDocument

'Create a list for skUCS
For Each oRefDoc As Document In oSubAsm.ReferencedDocuments
	'Get the wireframe
	If oRefDoc.DocumentType = Inventor.DocumentTypeEnum.kPartDocumentObject AndAlso oRefDoc.DisplayName.Contains("wireframe") Then
		wfDoc = oRefDoc	
		'MsgBox(wfDoc.DisplayName)
		wfUCSs = wfDoc.ComponentDefinition.UserCoordinateSystems
		
	End If
Next
	
	
For Each wfUCS As UserCoordinateSystem In wfUCSs
MsgBox(wfUCS.Name)
					
	'Create a list for asmUCS
	For Each oRefDoc As Document In oSubAsm.ReferencedDocuments
		If oRefDoc.DocumentType = Inventor.DocumentTypeEnum.kAssemblyDocumentObject
			Dim oAsmDoc As AssemblyDocument = oRefDoc
			Dim oCompDef As AssemblyComponentDefinition = oAsmDoc.ComponentDefinition
					
				For Each oUCS As UserCoordinateSystem In oCompDef.UserCoordinateSystems
					If oUCS.Name.Contains("Origin") Then
						'MsgBox(oUCS.Name)
						
						For Each oPartDoc As PartDocument In oAsmDoc.ReferencedDocuments
							If oPartDoc.DisplayName.Contains(wfUCS.Name) Then
								'MsgBox(wfUCS.Name)
								
								Dim i As Integer = 1
								Dim oMateName As String = "UcsToUcs_" & i
								Dim oComp1 As String
								oComp1 = oAsmDoc.DisplayName.Split(".").First & ":1"
								'MsgBox(oComp1)
								
								Dim oComp2 As String
								oComp2 = wfDoc.DisplayName.Split(".").First & ":1"
								'MsgBox(oComp2)

								Constraints.AddUcsToUcs(oMateName, oComp1, oUCS.Name, oComp2, wfUCS.Name, 
	                            xOffset := 0, yOffset := 0, zOffset := 0)
								
								i = i + 1
							End If		
						Next				
					End If					
				Next
		End If
	Next
Next
	

[Ralf_Krieg · Accepted solution]

Hello

Can't get your code to run even for the last item. Afaik, using components in a subassembly needs the "path" through the model structure. Otherwise, if the part is included in more than one subassembly, only the occurrence name is not unique.

Using the referenced documents collection will ignore all second, third, ... occurrence of a subassembly. I think it would be better to use the occurrences collection.

The code below will not work for assemblies with more than one subassembly level. But hopefully, it will fit your needs.

Dim oSubAsm As AssemblyDocument = ThisAssembly.Document
Dim wfUCSs As UserCoordinateSystems
'Dim wfDoc As PartDocument
Dim wfComp As PartComponentDefinition
Dim i As Integer = 1
Dim oSourceOcc As ComponentOccurrence

'Create a list for skUCS
For Each oOcc As ComponentOccurrence In oSubAsm.ComponentDefinition.Occurrences 
'For Each oRefDoc As Document In oSubAsm.ReferencedDocuments
	'Get the wireframe
	If oOcc.DefinitionDocumentType=DocumentTypeEnum.kPartDocumentObject AndAlso oOcc.Name.Contains("wireframe") Then
	'If oRefDoc.DocumentType = Inventor.DocumentTypeEnum.kPartDocumentObject AndAlso oRefDoc.DisplayName.Contains("wireframe") Then
		oSourceOcc=oOcc
		'wfDoc = oRefDoc	
		'wfUCSs = wfDoc.ComponentDefinition.UserCoordinateSystems
		wfComp=oOcc.Definition
		wfUCSs = wfComp.UserCoordinateSystems
	End If
Next
	
For Each wfUCS As UserCoordinateSystem In wfUCSs
	For Each oOcc As ComponentOccurrence In oSubAsm.ComponentDefinition.Occurrences 
	'For Each oRefDoc As Document In oSubAsm.ReferencedDocuments
		If oOcc.DefinitionDocumentType=Inventor.DocumentTypeEnum.kAssemblyDocumentObject Then
		'If oRefDoc.DocumentType = Inventor.DocumentTypeEnum.kAssemblyDocumentObject
			'Dim oAsmDoc As AssemblyDocument = oOcc.Definition.Document 
			'Dim oAsmDoc As AssemblyDocument = oRefDoc
			'Dim oCompDef As AssemblyComponentDefinition = oAsmDoc.ComponentDefinition
			For Each oSubOcc As ComponentOccurrence In oOcc.SubOccurrences 
			'For Each oPartDoc As PartDocument In oAsmDoc.ReferencedDocuments
				If oSubOcc.DefinitionDocumentType=DocumentTypeEnum.kPartDocumentObject And oSubOcc.Name.Contains(wfUCS.Name) Then
				'If oPartDoc.DisplayName.Contains(wfUCS.Name) Then
					For Each oUCS As UserCoordinateSystem In oSubOcc.Definition.usercoordinatesystems
					'For Each oUCS As UserCoordinateSystem In oPartDoc.ComponentDefinition.UserCoordinateSystems
						If oUCS.Name.Contains("Origin") Then
							Dim oMateName As String = "UcsToUcs_" & i
							Dim oComp1 As New ComponentArgument({oOcc.Name, oSubOcc.Name })
							'Dim oComp1 String
							'oComp1 = oPartDoc.DisplayName.Split(".").First & ":1"
							
							Dim oComp2 As String
							oComp2=oSourceOcc.Name 
							'oComp2 = wfDoc.DisplayName.Split(".").First & ":1"

							Constraints.AddUcsToUcs(oMateName, oComp1, oUCS.Name, oComp2, wfUCS.Name, xOffset := 0, yOffset := 0, zOffset := 0)
							
							i = i + 1
						End If		
					Next				
				End If					
			Next
		End If
	Next
Next