Well here is what I crunched the code to. If anyone can think of or find a stiuition that this doesnt work please let me (keep in mind that this is for sheet parts). I'm still learning error handeling, I'd like input about this also.
Thank you
Andy
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
