Iterate simple Rule in sub Part of assembly

Iterate simple Rule in sub Part of assembly

ts2.cad3
Enthusiast Enthusiast
466 Views
4 Replies
Message 1 of 5

Iterate simple Rule in sub Part of assembly

ts2.cad3
Enthusiast
Enthusiast

Hello, i wrote / copy-paste  a simple rule that read a quantity in a part and set some value in custom iPropriety.

Work well in part contest but now i need to iterate the rule in all the part in  assembly.

I try some code but whitout any result. Someone can help?

 

This is the rule that work fine in the part component:

Dim oPart As PartDocument = ThisApplication.ActiveEditDocument
Dim oCompDef As PartComponentDefinition = oPart.ComponentDefinition
Dim baseUnits As String = oCompDef.BOMQuantity.BaseUnits
Dim unitQuantity As String = oCompDef.BOMQuantity.UnitQuantity
'Dim quantityType As String = oCompDef.BOMQuantityTypeEnum
Dim quantity As Object = Nothing

MessageBox.Show(unitQuantity, "unitQuantity")

If baseUnits = "mm" Then
Dim UQN As Integer = InStrRev(unitQuantity," ",-1)
UQ = Left(unitQuantity,UQN)

DIMENSIONI = CDblAny(UQ)
QTA = CStr(CDblAny(UQ)/1000)


For i=1 To Len(QTA)
If Mid$(QTA, i, 1)= "," Then Mid$(QTA, i, 1) = "."
Next

MessageBox.Show(DIMENSIONI, "UQ")
MessageBox.Show(QTA, "QTA")
iProperties.Value("Custom", "QTA") = QTA
iProperties.Value("Custom", "DIMENSIONI") = DIMENSIONI
End If

 

And this is the try for iterate in all the part in assembly that don't work:

 

Sub Main ()
Dim oAsmDoc As AssemblyDocument
oAsmDoc = ThisApplication.ActiveDocument
Dim oAsmDef As AssemblyComponentDefinition
oAsmDef = oAsmDoc.ComponentDefinition

Dim oLeafOccs As ComponentOccurrencesEnumerator
oLeafOccs = oAsmDef.Occurrences.AllLeafOccurrences

Dim oOcc As ComponentOccurrence
Dim oBrowserNode As String

For Each oOcc In oLeafOccs
    
    Try
    
        
    Dim baseUnits As String = oOcc.ComponentDefinition.BOMQuantity.BaseUnits
    Dim unitQuantity As String = oOcc.ComponentDefinition.BOMQuantity.UnitQuantity
    'Dim quantityType As String = oCompDef.BOMQuantityTypeEnum

    
    'MessageBox.Show(unitQuantity, "unitQuantity")
    
    If baseUnits = "mm" Then
        Dim UQN As Integer = InStrRev(unitQuantity," ",-1)
        Dim UQ As String = Left(unitQuantity,UQN)
        
        Dim DIMENSIONI As String  = CDblAny(UQ)
        Dim QTA As Integer = CStr(CDblAny(UQ)/1000)
        
            For i=1 To Len(QTA)
            If Mid$(QTA, i, 1)= "," Then Mid$(QTA, i, 1) = "."
            Next
        

        oOcc.iProperties.Value("Custom", "QTA") = QTA
        oOcc.iProperties.Value("Custom", "DIMENSIONI") = DIMENSIONI
    End If

    Catch 'Do Nothing

    End Try
Next

End Sub

 

 

 

 

 

Accepted solutions (2)
467 Views
4 Replies
Replies (4)
Message 2 of 5

dalton98
Collaborator
Collaborator

This is an example of what your talking about. It goes through each row in the structured bom + child rows and get the quantity value. Then it creates a custom property called "QTY".

Sub Main
Dim oAss As AssemblyDocument
oAss= ThisApplication.ActiveDocument

Dim oBOM As BOM
oBOM = oAss.ComponentDefinition.BOM
oBOM.StructuredViewEnabled = True
oBOM.StructuredViewFirstLevelOnly = False

Dim oBOMView As BOMView
oBOMView = oBOM.BOMViews.Item("Structured")

Dim oRow As BOMRow
For Each oRow In oBOMView.BOMRows
qty = oRow.ItemQuantity
Dim oDoc As Document
oDoc = oRow.ComponentDefinitions.Item(1).Document
Dim oProperty As Inventor.Property
oProperty = oDoc.PropertySets.Item("Inventor User Defined Properties").Add(qty, "QTY")
If Not oRow.ChildRows Is Nothing
Call RecurseBOMRow(oRow)
End If
Next
End Sub

Sub RecurseBOMRow(oRow As BOMRow)
For Each oRow In oRow.ChildRows
qty = oRow.ItemQuantity
Dim oDoc As Document
oDoc = oRow.ComponentDefinitions.Item(1).Document
Dim oProperty As Inventor.Property
oProperty = oDoc.PropertySets.Item("Inventor User Defined Properties").Add(qty, "QTY")
If Not oRow.ChildRows Is Nothing
Call RecurseBOMRow(oRow)
End If
Next
End Sub
Message 3 of 5

gaetano.armenise.85
Explorer
Explorer
Accepted solution

Hello,
If I understand correctly, the goal is to reiterate the function of modifying the iProperties in the individual files that make up the assembly and not in the BOM of the assembly that contains them. I tried to fix the code a bit, I managed to get the quantities ( the lengths in mm of the individual.ipt of the tubulars) but not to write them in a custom iProp, maybe someone else knows how to do it

' Get the active assembly.
Dim oAsmDoc As AssemblyDocument
oAsmDoc = ThisApplication.ActiveDocument
' Get the assembly component definition.
Dim oAsmCompDef As AssemblyComponentDefinition
oAsmCompDef = oAsmDoc.ComponentDefinition

oRefDocs = oAsmDoc.AllReferencedDocuments
Dim oRefDoc As Document
'work the the drawing files for the referenced models
'this expects that the model has a drawing of the same path and name
For Each oRefDoc In oRefDocs


	Dim baseUnits As String = oRefDoc.ComponentDefinition.BOMQuantity.BaseUnits
	Dim unitQuantity As String = oRefDoc.ComponentDefinition.BOMQuantity.UnitQuantity



	If baseUnits = "mm" Then
		Dim UQN As Integer = InStrRev(unitQuantity, " ", -1)
		Dim UQ As String = Left(unitQuantity, UQN)

		Dim DIMENSIONI As Double = CDblAny(UQ)
		Dim QTA As String = CStr(CDblAny(UQ) / 1000)

		For i = 1 To Len(QTA)
			If Mid$(QTA, i, 1) = "," Then Mid$(QTA, i, 1) = "."
		Next
		MessageBox.Show(QTA, "QTA")
		Dim oRefDocOB As Object = oRefDoc
		'
		iProperties.Value(oRefDocOB, "Custom", "QTA") = QTA
		iProperties.Value(oRefDocOB, "Custom", "DIMENSIONI") = DIMENSIONI


	End If
Next

 

Message 4 of 5

Ralf_Krieg
Advisor
Advisor
Accepted solution

Hello

 

iProperties.Value method expects as first argument a string with the document name, not an document object.

 

' Get the active assembly.
Dim oAsmDoc As AssemblyDocument= ThisDoc.Document

Dim oRefDoc As Document
For Each oRefDoc In oAsmDoc.AllReferencedDocuments 
	Dim baseUnits As String = oRefDoc.ComponentDefinition.BOMQuantity.BaseUnits
	Dim unitQuantity As String = oRefDoc.ComponentDefinition.BOMQuantity.UnitQuantity

	If baseUnits = "mm" Then
		Dim UQN As Integer = InStrRev(unitQuantity, " ", -1)
		Dim UQ As String = Left(unitQuantity, UQN)

		Dim DIMENSIONI As Double = CDblAny(UQ)
		Dim QTA As String = CStr(CDblAny(UQ) / 1000)

		For i = 1 To Len(QTA)
			If Mid$(QTA, i, 1) = "," Then Mid$(QTA, i, 1) = "."
		Next
		iProperties.Value(System.IO.Path.GetFileName(oRefDoc.FullFileName) , "Custom", "QTA") = QTA
		iProperties.Value(System.IO.Path.GetFileName(oRefDoc.FullFileName) , "Custom", "DIMENSIONI") = DIMENSIONI
	End If
Next

R. Krieg
RKW Solutions
www.rkw-solutions.com
Message 5 of 5

gaetano.armenise.85
Explorer
Explorer
Thank you Krieg, works perfectly now 🙂