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
Solved! Go to Solution.
Solved by Ralf_Krieg. Go to 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
Can't find what you're looking for? Ask the community or share your knowledge.