Haggard VBA code to count bends and add time to iproperty

[Anonymous]

Public Sub BendingTime()

'set a constant to identify sheet metal parts
Const CLSID_InventorSheetMetalPart_RegGUID = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}"

Dim m_inventorapplication As Inventor.Application
Set m_inventorapplication = GetObject(, "Inventor.Application")

'check that this is running on an assembly document
If (m_inventorapplication.ActiveDocumentType <> DocumentTypeEnum.kPartDocumentObject) Then

    'get the active assembly
    Dim asmDoc As AssemblyDocument
    Set asmDoc = ThisApplication.ActiveDocument
    
Call TraverseAssembly(asmDoc.ComponentDefinition.Occurrences)

End If

msgbox ("this runs on assembly documents only")


End Sub





Private Sub TraverseAssembly(Occurrances As ComponentOccurrences)
        
    Dim Occ As ComponentOccurrence
    Dim oSheetMetalComp As Inventor.SheetMetalComponentDefinition
    Dim iBendCount As Integer
    Dim oCustomProps As Inventor.PropertySet
    Dim sBendPropName As String
    sBendPropName = "Bend Time"
    Dim oBendProp As Inventor.Property
    Dim oProp As Inventor.Property
    
  
    For Each Occ In Occurrances

          'If Occ.SubType = CLSID_InventorSheetMetalPart_RegGUID Then
                Set oSheetMetalComp = Occ.ComponentDefinition
                iBendTime = oSheetMetalComp.Bends.Count * 0.00556
                Set oCustomProps = Occ.PropertySets.Item("Inventor User Defined Properties")
                For Each oProp In oCustomProps
                    If oProp.Name = sBendPropName Then
                        'We already have an iproperty, we just need to write the new value
                    Set oBendProp = oProp
                        oBendProp.Value = iBendTime
                    End If
            Next oProp
          'We don't have an iproperty, so we create it and set its value
            If oBendProp Is Nothing Then Set oBendProp = oCustomProps.Add(iBendTime, sBendPropName)
          
    If Occ.Definition.DocumentType = kAssemblyDocumentObject Then
        Call TraverseAssembly(Occ.SubOccurrences)
        End If
                
    'Else
     'MsgBox ("not a sheetmetal doc.")
                
    
 Next

End Sub

I have searched quite a lot for people to just write my code for me without any result - actually surprising.   I even set up some stuff on fiverr!  No luck!

...so here is my cleaned up version where I combined a few snippets to try to add bend times to an assembly of parts, and to all subsequent subassemblies.

It won't detect if each part is sheetmetal - needs an if statement so it skips over standard parts without just erroring, silently.

I may be declaring things outside of the loop when I need to declare them inside the loop - but that doesn't make sense to me.

Currently hangs up at the red line, object doesn't support this property.  But it should!  Unless I need to declare the Occ as something else first.  I'm running this on an assembly comprised only of sheetmetal parts, so shouldn't be because it's a standard part it's finding.

Thanks in advance for any tips, and have a happy holidays!

James

[bradeneuropeArthur]

Set oSheetMetalComp = Occ.document.ComponentDefinition

[chandra.shekar.g]

Hi @Anonymous,

Try the following VBA code

Set oSheetMetalComp = occ.Definition

Please feel free to contact if there is any queries,

If solves problem, click on "Accept as solution" / give a "Kudo"

Thanks and regards,

[dgreatice · Accepted solution]

Hi,

try this :

Public Sub BendingTime()

Dim m_inventorapplication As Inventor.Application
Set m_inventorapplication = GetObject(, "Inventor.Application")

'check that this is running on an assembly document
If (m_inventorapplication.ActiveDocumentType <> DocumentTypeEnum.kPartDocumentObject) Then

    'get the active assembly
    Dim asmDoc As AssemblyDocument
    Set asmDoc = ThisApplication.ActiveDocument
   
Call TraverseAssembly(asmDoc.ComponentDefinition.Occurrences)
asmDoc.Update
End If

msgbox ("this runs on assembly documents only")


End Sub

Private Sub TraverseAssembly(Occurrances As ComponentOccurrences)
       
    Dim Occ As ComponentOccurrence
    Dim oSheetMetalComp As Inventor.SheetMetalComponentDefinition
    Dim iBendCount As Integer
    Dim oCustomProps As Inventor.PropertySet
    Dim sBendPropName As String
    sBendPropName = "Bend Time"
    Dim oBendProp As Inventor.Property
    Dim oProp As Inventor.Property
    Dim PartDoc As PartDocument
 
    For Each Occ In Occurrances

          If Occ.DefinitionDocumentType = kAssemblyDocumentObject Then
            Call TraverseAssembly(Occ.SubOccurrences)
        ElseIf Occ.DefinitionDocumentType = kPartDocumentObject Then
            Set PartDoc = Occ.ReferencedDocumentDescriptor.ReferencedDocument
            If PartDoc.SubType = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" Then
                Set oSheetMetalComp = PartDoc.ComponentDefinition
                iBendTime = oSheetMetalComp.Bends.Count * 0.00556
                Set oCustomProps = PartDoc.PropertySets.Item("Inventor User Defined Properties")
               
                On Error Resume Next
                Set oBendProp = oCustomProps.Item(sBendPropName)
               
                If Err.Number <> 0 Then
                    'We don't have an iproperty, so we create it and set its value
                    Set oBendProp = oCustomProps.Add(iBendTime, sBendPropName)
                Else
                    oBendProp.Value = iBendTime
                End If
            End If
        End If

     Next

End Sub

[Anonymous]

😄 Thank you!

It sends me the "this runs on on assembly documents only" every time - so I just changed that line to "done."

Works great with sub assemblies - I'm in business.

[Anonymous]

Can someone update the code, its not working. Thank you

[bradeneuropeArthur]

Hi,

Why it is not working for you?

What is the error message?

What inventor version are you using?

Regards,

[Anonymous]

Today I manage to run the code in MACRO and it will return error massage:

this runs on assembly documents only

 I am using it in assembly with a lot of sheet metal parts, and other parts, but never mind the message error.

Can you tell me where are the results?

In iProperties in custom section there is no iBendTime. I am intersting in just BEND COUNTS because I need to have the number of times the bend machine will be used. If its needed I can just put 1 instead of 0.00556 to get bend counts, but I cant find the final result.