@Martin-Winkler-Consulting and @MechMachineMan thank you for your support! 🙂 I have managed to complete the code with your help.
Maybe someone will have use for it too.
This code creates X, Y, Z measurements of the bounding box of a part (Part must be perpendiculart to X, Y, Z axises) and can create dimensions DIMALL which has the longest, shorter, and shortest dimensions consequently.
Sub Bounding_Box_Main()
Dim oAsmDoc As AssemblyDocument
Set oAsmDoc = ThisApplication.ActiveDocument
Call Bounding_Box(oAsmDoc.ComponentDefinition.Occurrences, 1)
End Sub
Sub Bounding_Box(Occurrences As ComponentOccurrences, _
Level As Integer)
' Iterate through all of the occurrence in this collection. This
' represents the occurrences at the top level of an assembly.
Dim oOcc As ComponentOccurrence
Dim oCustomPropSet As PropertySet
Dim modX As Double
Dim modY As Double
Dim modZ As Double
For Each oOcc In Occurrences
'If it is an Assembly go to next Level
Set oCustomPropSet = oOcc.Definition.Document.PropertySets.Item(4)
If oOcc.DefinitionDocumentType = kAssemblyDocumentObject Then
Call Bounding_Box(oOcc.SubOccurrences, Level + 1)
ElseIf oOcc.DefinitionDocumentType = kPartDocumentObject Then
'Get the ranges Model X, Model Y, Model Z
modX = (oOcc.RangeBox.MaxPoint.X + (oOcc.RangeBox.MinPoint.X) * -1) * 10
modY = (oOcc.RangeBox.MaxPoint.Y + (oOcc.RangeBox.MinPoint.Y) * -1) * 10
modZ = (oOcc.RangeBox.MaxPoint.Z + (oOcc.RangeBox.MinPoint.Z) * -1) * 10
'Round to 0
modXr = Round(modX, 0)
modYr = Round(modY, 0)
modZr = Round(modZ, 0)
'Get the UserDefinedPropertySet
Set oCustomPropSet = oOcc.Definition.Document.PropertySets.Item(4)
' For X
If CheckPropertyExists(oCustomPropSet, "ModX") Then
oCustomPropSet.Item("ModX").Expression = modXr
Else
Call oCustomPropSet.Add(modXr, "ModX")
End If
' For Y
If CheckPropertyExists(oCustomPropSet, "ModY") Then
oCustomPropSet.Item("ModY").Expression = modYr
Else
Call oCustomPropSet.Add(modYr, "ModY")
End If
' For Z
If CheckPropertyExists(oCustomPropSet, "ModZ") Then
oCustomPropSet.Item("ModZ").Expression = modZr
Else
Call oCustomPropSet.Add(modZr, "ModZ")
End If
'Create DIMALLLL L x W x H
If modXr >= modYr And modYr >= modZr Then
DIMALL = modX & "x" & modY & "x" & modZ
ElseIf modXr >= modZr And modZr >= modYr Then
DIMALL = modXr & "x" & modZr & "x" & modYr
ElseIf modYr >= modZr And modZr >= modXr Then
DIMALL = modYr & "x" & modZr & "x" & modXr
ElseIf modYr > modXr And modXr > modZr Then
DIMALL = modYr & "x" & modXr & "x" & modZr
ElseIf modZr > modXr And modXr > modYr Then
DIMALL = modZr & "x" & modXr & "x" & modYr
ElseIf modZr > modYr And modYr > modXr Then
DIMALL = modZr & "x" & modYr & "x" & modXr
End If
If CheckPropertyExists(oCustomPropSet, "DIMALL") Then
oCustomPropSet.Item("DIMALL").Expression = DIMALL
Else
Call oCustomPropSet.Add(DIMALL, "DIMALL")
End If
End If
Next
End Sub
Public Function CheckPropertyExists(oProps As PropertySet, oPropName As String) As Boolean
CheckPropertyExists = False
Dim oProp As Property
For Each oProp In oProps
If oProp.Name = oPropName Then
CheckPropertyExists = True
End If
Next
End Function