Hi,
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.
any ideas?
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.
Hi Frstam,
not alligned.
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.
Hi,
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:
http://adndevblog.typepad.com/manufacturing/2012/06/creating-accurate-rangebox-for-component.html
Cheers,
Hi Adam,
thanks for the answer.
The code is from Andy73 ( http://forums.autodesk.com/t5/Inventor-Customization/Extents-of-parts/m-p/1869988/highlight/true#M19 )
The objective to use it with iLogic in a multibody workflow to obtain part lists with range box extents with whatever parts oriented.
The VBA code is this:
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.
Ahh, I thought the part was at least lining up with its own coordinate system - usually that seems to be the case.
If not, then you'd need some minimum bounding box algorithm.
Cheers,
Yes ..can i find the code somewhere?
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.
Googling around I found this - not sure how good it is:
http://www.geometrictools.com/LibMathematics/Containment/Containment.html
No, unfortunately not the solution for 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.
Maybe a workaround is to create a sketch on let say XY-plan, project the hole part on that plane.
Loop through:
each straight line and find the max and min values.
if non lineair, calculate via radius, start, end & centerpoint the max/min distance.
Do the same for XZ plane.
First you could do this manual, see if the result is ok before programming...
I know, a lot of work, but i don't see any other solution for the moment.
Thanks for your answer.
Unfortnately
I can't do that. It's needed a lite solution.
We have thousands of parts on which to do this.
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?
Hi Adam,
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.
Any idea in the meantime?
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't find what you're looking for? Ask the community or share your knowledge.