is there a way, or something already done, with iLogic or in VBA to obtain the 3 maximun measure of the bouding box of parts in a assembly?
With the final objective to recall that in the parts list in the drawing.
Moreover...That works with rotated partes and that calculates the measures no-dependant from the origin 0,0,0 ...
and works even with parts with circular cuts (holes, cuts, etc).
Thanks!!
Admaiora Did you find this post helpful? Feel free to Like this post. Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
Admaiora Did you find this post helpful? Feel free to Like this post. Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
If your part is alligned with its coordinate system, these would be your answer:
PartDocument.ComponentDefinition.RangeBox.MaxPoint PartDocument.ComponentDefinition.RangeBox.MinPoint The X, Y and Z are in centi meter.
If the part is not alligned with its coordinate system it is not that easy. The answer are in the Vertices of the SurfaceBodies, but I have not seen any sample for how to calculate the smallest envelope from that..
I mean to use it with multibody origined parts, so part not alligned, rotated, etc.
I know that it's not easy. The best way i have foudn is a mix with VBA and iLogic but it doesn't works with parts with circular cuts for example, not reliable.
Admaiora Did you find this post helpful? Feel free to Like this post. Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
I guess by cuts you meant assembly features cutting into the part, and not cuts created inside the part document, right?
If the cuts are inside the part document, then you could get the bounding box directly inside the part and then translate its positions into assembly context.
If the part cuts are created in the assembly, then maybe this could be of help:
Public Sub FindExtents()
Dim opartdoc As PartDocument
Dim oCompDef As PartComponentDefinition
Dim oAssdoc As AssemblyDocument
Dim oCompAssDef As AssemblyComponentDefinition
Dim oParams As UserParameters
Dim Mx(2) As Double, Mi(2) As Double
Dim MxX As Double, MxY As Double, MxZ As Double
Dim MiX As Double, MiY As Double, MiZ As Double
Dim oDoc As Document
Dim NumberList(2) As Double
Set oDoc = ThisApplication.ActiveDocument
Select Case oDoc.DocumentType
Case kPartDocumentObject
Set opartdoc = oDoc
Set oCompDef = opartdoc.ComponentDefinition
Dim oBody As SurfaceBody
Set oBody = opartdoc.ComponentDefinition.SurfaceBodies.Item(1)
TightBoundingBox Mi, Mx
Case Else
Exit Sub
End Select
NumberList(0) = Mx(0) - Mi(0)
NumberList(1) = Mx(1) - Mi(1)
NumberList(2) = Mx(2) - Mi(2)
NumberSort NumberList()
Set oParams = opartdoc.ComponentDefinition.Parameters.UserParameters
Dim LenBol As Boolean, WidBol As Boolean, ThiBol As Boolean
LenBol = False
WidBol = False
ThiBol = False
If oParams.Count > 0 Then
Dim iNumParams As Integer
For iNumParams = 1 To oParams.Count
Select Case oParams.Item(iNumParams).Name
Case "LENGTH"
oParams.Item(iNumParams).Value = NumberList(0)
LenBol = True
Case "WIDTH"
oParams.Item(iNumParams).Value = NumberList(1)
WidBol = True
Case "THICKNESS"
oParams.Item(iNumParams).Value = NumberList(2)
ThiBol = True
End Select
Next iNumParams
End If
If LenBol = False Then oParams.AddByValue "LENGTH", NumberList(0), kDefaultDisplayLengthUnits
If WidBol = False Then oParams.AddByValue "WIDTH", NumberList(1), kDefaultDisplayLengthUnits
If ThiBol = False Then oParams.AddByValue "THICKNESS", NumberList(2), kDefaultDisplayLengthUnits
End Sub
Sub TightBoundingBox(ByRef Mi() As Double, ByRef Mx() As Double)
Dim oDoc As PartDocument
Set oDoc = ThisApplication.ActiveDocument
Dim oTG As TransientGeometry
Set oTG = ThisApplication.TransientGeometry
Dim oOriginalRangeBox As Box
Set oOriginalRangeBox = oDoc.ComponentDefinition.SurfaceBodies(1).RangeBox
Debug.Print "start dX: " & oOriginalRangeBox.MaxPoint.X - oOriginalRangeBox.MinPoint.X & " " & _
"start dY: " & oOriginalRangeBox.MaxPoint.Y - oOriginalRangeBox.MinPoint.Y & " " & _
"start dZ: " & oOriginalRangeBox.MaxPoint.Z - oOriginalRangeBox.MinPoint.Z
Dim oBody As SurfaceBody
Set oBody = oDoc.ComponentDefinition.SurfaceBodies(1)
Dim oFace As Face
Dim oFaceIdx As Integer
oFaceIdx = GetLargestFaceIndex(oBody, oFace)
' Get the Z vector Normal to the face
Dim oVec1 As Vector, Zvec As Vector, Yvec As Vector, Xvec As Vector
Dim VecNor As UnitVector
Set VecNor = oFace.Geometry.Normal
Set Zvec = VecNor.AsVector
Set oVec1 = Zvec
' Get the Z-Axis vector
Dim oVec2 As Vector
Set oVec2 = oDoc.ComponentDefinition.WorkAxes(3).Line.Direction.AsVector
' Create a matrix that will rotate the body such that the
' direction of the Largest Face Normal coincides with Z-Axis.
Dim oMatZ As Matrix
Set oMatZ = ThisApplication.TransientGeometry.CreateMatrix
Call oMatZ.SetToRotateTo(oVec1, oVec2, Nothing)
' Get the vector along Longest Edge
Set Yvec = GetLongestEdgeVector(oFace)
Set Xvec = Zvec.CrossProduct(Yvec)
Set Yvec = Xvec.CrossProduct(Zvec)
Set oVec1 = Yvec
oVec1.TransformBy oMatZ
' Get the Y-Axis vector
Set oVec2 = oDoc.ComponentDefinition.WorkAxes(2).Line.Direction.AsVector
' Create a matrix that will rotate the body such that the
' direction of the Longest Edge coincides with Y-Axis.
Dim oMatY As Matrix
Set oMatY = ThisApplication.TransientGeometry.CreateMatrix
Call oMatY.SetToRotateTo(oVec1, oVec2, Nothing)
' Combine the 2 matrices
oMatZ.TransformBy oMatY
' Set the vector as the cross product of Zvec and Yzec
Set oVec1 = Xvec
oVec1.TransformBy oMatZ
' Get the X-Axis vector
Set oVec2 = oDoc.ComponentDefinition.WorkAxes(1).Line.Direction.AsVector
' Create a matrix that will rotate the body such that the
' direction of the second selection coincides with X-Axis.
Dim oMatX As Matrix
Set oMatX = ThisApplication.TransientGeometry.CreateMatrix
Call oMatX.SetToRotateTo(oVec1, oVec2, Nothing)
' Combine the 2 matrices
oMatZ.TransformBy oMatX
Dim oDerDoc As PartDocument
Set oDerDoc = ThisApplication.Documents.Add(kPartDocumentObject, , False)
Dim oDerCompDef As PartComponentDefinition
Set oDerCompDef = oDerDoc.ComponentDefinition
Dim oDerPartDef As DerivedPartTransformDef
Set oDerPartDef = oDerCompDef.ReferenceComponents.DerivedPartComponents.CreateTransformDef _
(oDoc.FullFileName)
oDerPartDef.SetTransformation oMatZ
oDerCompDef.ReferenceComponents.DerivedPartComponents.Add oDerPartDef
Dim oTightRangeBox As Box
Set oTightRangeBox = oDerCompDef.SurfaceBodies(1).RangeBox
oTightRangeBox.GetBoxData Mi, Mx
Debug.Print " End dX: " & oTightRangeBox.MaxPoint.X - oTightRangeBox.MinPoint.X & " " & _
"End dY: " & oTightRangeBox.MaxPoint.Y - oTightRangeBox.MinPoint.Y & " " & _
"End dZ: " & oTightRangeBox.MaxPoint.Z - oTightRangeBox.MinPoint.Z
oDerDoc.Close
End Sub
Public Function GetLargestFaceIndex(oBody As SurfaceBody, oFace As Face) As Integer
Dim FaceCount As Integer, N As Integer, X As Integer, I As Integer
FaceCount = oBody.Faces.Count
Dim oFace1 As Face, oFace2 As Face
Do
I = 1
X = I
Set oFace1 = oBody.Faces(I)
If oFace1.SurfaceType = kPlaneSurface Then
For N = I + 1 To FaceCount
Set oFace2 = oBody.Faces(N)
If oFace2.SurfaceType = kPlaneSurface Then
If oFace2.Evaluator.Area > oFace1.Evaluator.Area Then
Set oFace1 = oFace2
X = N
End If
End If
Next N
End If
I = I + 1
Loop While N <= FaceCount
If oFace1.SurfaceType <> kPlaneSurface Then
For N = 2 To FaceCount
Set oFace2 = oBody.Faces(N)
If oFace2.Evaluator.Area > oFace1.Evaluator.Area Then
Set oFace1 = oFace2
X = N
End If
Next N
End If
Set oFace = oFace1
GetLargestFaceIndex = X
End Function
Public Function GetLongestEdgeVector(oFace As Face) As Vector
Dim EdgeCount As Integer, N As Integer, X As Integer
Dim Pt1() As Double, Pt2() As Double
Dim Len1 As Double, Len2 As Double
EdgeCount = oFace.Edges.Count
Dim oEdge1 As Edge, oEdge2 As Edge
Set oEdge1 = oFace.Edges(1)
oEdge1.Evaluator.GetEndPoints Pt1, Pt2
Len1 = Sqr(((Pt1(0) - Pt2(0)) ^ 2) + ((Pt1(1) - Pt2(1)) ^ 2) + ((Pt1(2) - Pt2(2)) ^ 2))
X = 1
For N = 2 To EdgeCount
Set oEdge2 = oFace.Edges(N)
oEdge2.Evaluator.GetEndPoints Pt1, Pt2
Len2 = Sqr(((Pt1(0) - Pt2(0)) ^ 2) + ((Pt1(1) - Pt2(1)) ^ 2) + ((Pt1(2) - Pt2(2)) ^ 2))
If Len2 > Len1 Then
Set oEdge1 = oEdge2
X = N
End If
Next N
Dim oTG As TransientGeometry
Set oTG = ThisApplication.TransientGeometry
Dim TempVec As UnitVector
oEdge1.Evaluator.GetEndPoints Pt1, Pt2
Set TempVec = oTG.CreateUnitVector(Pt2(0) - Pt1(0), Pt2(1) - Pt1(1), Pt2(2) - Pt1(2))
Set GetLongestEdgeVector = TempVec.AsVector
End Function
Public Function NumberSort(ByRef NumberList() As Double) As Double
Dim I As Integer, N As Integer, X As Double
For I = 0 To UBound(NumberList) - 1
For N = I + 1 To UBound(NumberList)
If NumberList(I) < NumberList(N) Then
X = NumberList(I)
NumberList(I) = NumberList(N)
NumberList(N) = X
End If
Next N
Next I
End Function
The parts cuts i refer are part features, insides ipts.
Here a video of the use of it.
As you can see it works fine, but it stuck/freeze thinking when the part contains circular/curve cuts (hole, slots, etc).
Thanks for support!
Admaiora Did you find this post helpful? Feel free to Like this post. Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
I have tried the code you suggest but doesn't create the maximum extends of the part that i mean (in the image i would like as extends: 1800x1500x654 mm)
Moreover i have no clear how can i use that box to obtain the three maximum extends for the part list or write acustom iprop.
Admaiora Did you find this post helpful? Feel free to Like this post. Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
Admaiora Did you find this post helpful? Feel free to Like this post. Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
Admaiora Did you find this post helpful? Feel free to Like this post. Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
The code i posted above works, as i have shown in the video, only there are the limits of the circular cuts, so there are solutions in VBA or iLogic out there. I was hoping in someone who can put light on this.
Admaiora Did you find this post helpful? Feel free to Like this post. Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
I think that it may be due to the difficulty to calculate the vector normal of a curve surface.
I hope that someone really good with vba can have a more clear vision of me of all of this.
Admaiora Did you find this post helpful? Feel free to Like this post. Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
You said "As you can see it works fine, but it stuck/freeze thinking when the part contains circular/curve cuts (hole, slots, etc)."
Yes it gets stuck... so... why don't you debug into the code to see why it gets stuck? 😉
I did that and found this in GetLargestFaceIndex:
Dim FaceCount As Integer, N As Integer, X As Integer, I As Integer
FaceCount = oBody.Faces.Count
Dim oFace1 As Face, oFace2 As Face
Do
I = 1 ' << this should be outside 'Do' otherwise it's set back to 1 all the time
X = I
' etc..
I = I + 1
Loop While N <= FaceCount
' etc.
End Function
I'm also not sure why you check only planar faces if later on you check the non-planar ones anyway?
te code isn't mine as i wrote and i am not an vba expert.
Just asking for who can help me in that, hoping that it can be useful for other peaople too.
Admaiora Did you find this post helpful? Feel free to Like this post. Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
Admaiora Did you find this post helpful? Feel free to Like this post. Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
..can i find the code somewhere?