Attribute VB_Name = "Modul1"
Option Explicit

 

Public Sub BoundingBoxProp()

    ' Set reference to active document.

    ' This assumes the active document is an assembly

    Dim oDoc As Inventor.AssemblyDocument

    Set oDoc = ThisApplication.ActiveDocument

 

    ' Get assembly component definition

    Dim oCompdef As Inventor.ComponentDefinition

    Set oCompdef = oDoc.ComponentDefinition

 

    Dim sMsg As String

    Dim iLeafNodes As Long

    Dim iSubAssemblies As Long

 

    ' Get all occurrences from component definition for Assembly document

    Dim oCompOcc As ComponentOccurrence

    For Each oCompOcc In oCompdef.Occurrences

        ' Check if it's child occurrence (leaf node)

        If oCompOcc.SubOccurrences.Count = 0 Then

            Debug.Print oCompOcc.Name

            Call rangebox(oCompOcc)

            iLeafNodes = iLeafNodes + 1

        Else

            Debug.Print oCompOcc.Name

            iSubAssemblies = iSubAssemblies + 1

 

            Call processAllSubOcc(oCompOcc, sMsg, iLeafNodes, iSubAssemblies) 'subassembly

        End If

    Next

 

    MsgBox "Bounding box data of all components in this assembly has been succesfully created as custom props"

    Debug.Print "No of leaf nodes : " + CStr(iLeafNodes)

    Debug.Print "No of sub assemblies: " + CStr(iSubAssemblies)

End Sub

 

' This function is called for processing sub assembly. It is called recursively

' to iterate through the entire assembly tree.

Private Sub processAllSubOcc(ByVal oCompOcc As ComponentOccurrence, ByRef sMsg As String, ByRef iLeafNodes As Long, ByRef iSubAssemblies As Long)

 

    Dim oSubCompOcc As ComponentOccurrence

    For Each oSubCompOcc In oCompOcc.SubOccurrences

        ' Check if it's child occurrence (leaf node)

        If oSubCompOcc.SubOccurrences.Count = 0 Then

            Debug.Print oSubCompOcc.Name

            Call rangebox(oSubCompOcc)

            iLeafNodes = iLeafNodes + 1

        Else

            sMsg = sMsg + oSubCompOcc.Name + vbCr

            iSubAssemblies = iSubAssemblies + 1

 

            Call processAllSubOcc(oSubCompOcc, sMsg, iLeafNodes, iSubAssemblies)

        End If

    Next

End Sub

 

 

Sub rangebox(oCompdef As ComponentOccurrence)

 

Dim oRangebox As Inventor.Box

Set oRangebox = oCompdef.rangebox

 

Dim objUOM As UnitsOfMeasure

Set objUOM = oCompdef.Definition.Document.UnitsOfMeasure

 

Call Create_ext_prop(oCompdef.Definition.Document, "length", objUOM.GetStringFromValue(Abs(oRangebox.MaxPoint.X - oRangebox.MinPoint.X), UnitsTypeEnum.kDefaultDisplayLengthUnits))

Call Create_ext_prop(oCompdef.Definition.Document, "width", objUOM.GetStringFromValue(Abs(oRangebox.MaxPoint.Y - oRangebox.MinPoint.Y), UnitsTypeEnum.kDefaultDisplayLengthUnits))

Call Create_ext_prop(oCompdef.Definition.Document, "height", objUOM.GetStringFromValue(Abs(oRangebox.MaxPoint.Z - oRangebox.MinPoint.Z), UnitsTypeEnum.kDefaultDisplayLengthUnits))

End Sub

 

Sub Create_ext_prop(oDoc As Document, prop As String, prop_value As String)

 

Dim opropsets As PropertySets

Dim opropset As PropertySet

Dim oUserPropertySet As PropertySet

Dim i As Integer

 

Set opropsets = oDoc.PropertySets

 

For Each opropset In opropsets

    If opropset.Name = "Inventor User Defined Properties" Then Set oUserPropertySet = opropset

Next opropset

 

' If Property does not exist then add the new Property

On Error Resume Next

        Call oUserPropertySet.Add(prop_value, prop)

' Try to set the Property value if it already exists

 For i = 1 To oUserPropertySet.Count

   If oUserPropertySet.Item(i).Name = prop Then oUserPropertySet.Item(i).Value = prop_value

 Next i

 

End Sub