Solved: Can't call the function to get the tight bounding box

ngocson8335 · ‎10-09-2018

Dear Experts,

Please help me to fix the problem, I can't call the function to get the tight bounding box by VBA.Net. I'm using the Microsoft studio to coding.

How can I fix this problem?

Thank you so much.

Ngoc Son

Inventor's user

Ngoc Son
Autodesk User

bradeneuropeArthur · ‎10-09-2018

How does the function look like?

ngocson8335 · ‎10-09-2018

It looks like:

Imports System
Imports System.Runtime.InteropServices
Imports Inventor

Public Class Form1

Dim invApp As Inventor.Application
Dim partDoc As Inventor.PartDocument

Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load

invApp = Marshal.GetActiveObject("Inventor.Application")

End Sub

Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click

partDoc = invApp.ActiveDocument

Dim body As SurfaceBody
body = invApp.CommandManager.Pick(SelectionFilterEnum.kPartBodyFilter, "Select the body.")

Dim bndBox As Box = calculateTightBoundingBox(body)

Dim sk As Sketch3D = partDoc.ComponentDefinition.Sketches3D.Add()

Dim lines As SketchLines3D = sk.SketchLines3D

Dim tg As TransientGeometry = invApp.TransientGeometry

Dim minXYZ As Point = bndBox.MinPoint

Dim minXYmaxZ As Point = tg.CreatePoint(bndBox.MinPoint.X, bndBox.MinPoint.Y, bndBox.MaxPoint.Z)
Dim minXmaxYZ As Point = tg.CreatePoint(bndBox.MinPoint.X, bndBox.MaxPoint.Y, bndBox.MaxPoint.Z)
Dim minXZmaxY As Point = tg.CreatePoint(bndBox.MinPoint.X, bndBox.MaxPoint.Y, bndBox.MinPoint.Z)

Dim maxXYZ As Point = bndBox.MaxPoint
Dim maxXYminZ As Point = tg.CreatePoint(bndBox.MaxPoint.X, bndBox.MaxPoint.Y, bndBox.MinPoint.Z)
Dim maxXZminY As Point = tg.CreatePoint(bndBox.MaxPoint.X, bndBox.MinPoint.Y, bndBox.MaxPoint.Z)
Dim maxXminYZ As Point = tg.CreatePoint(bndBox.MaxPoint.X, bndBox.MinPoint.Y, bndBox.MinPoint.Z)

lines.AddByTwoPoints(minXYZ, minXYmaxZ)
lines.AddByTwoPoints(minXYZ, minXZmaxY)
lines.AddByTwoPoints(minXZmaxY, minXmaxYZ)
lines.AddByTwoPoints(minXYmaxZ, minXmaxYZ)

lines.AddByTwoPoints(maxXYZ, maxXYminZ)
lines.AddByTwoPoints(maxXYZ, maxXZminY)
lines.AddByTwoPoints(maxXYminZ, maxXminYZ)
lines.AddByTwoPoints(maxXZminY, maxXminYZ)

lines.AddByTwoPoints(minXYZ, maxXminYZ)
lines.AddByTwoPoints(minXYmaxZ, maxXZminY)
lines.AddByTwoPoints(minXmaxYZ, maxXYZ)
lines.AddByTwoPoints(minXZmaxY, maxXYminZ)

End Sub

End Class

Ngoc Son
Autodesk User

bradeneuropeArthur · ‎10-09-2018

I mean how does the function or module "calculateTightBoundingBox" look like

bradeneuropeArthur · ‎10-09-2018

use this instead because you function is missing...

Public Sub TestTightBoundingBox()
    Dim invApp As Inventor.Application = GetObject(, "Inventor.Application")
    ' Have a body selected.
    Dim body As SurfaceBody
    body = invApp.CommandManager.Pick(SelectionFilterEnum.kPartBodyFilter, "Select the body.")

    ' Call the function to get the tight bounding box.
    Dim bndBox As Box = calculateTightBoundingBox(body)

    ' Draw the bounding box using a 3D sketch.
    Dim partDoc As PartDocument = invApp.ActiveDocument
    Dim sk As Sketch3D = partDoc.ComponentDefinition.Sketches3D.Add()
    Dim lines As SketchLines3D = sk.SketchLines3D

    Dim tg As TransientGeometry = invApp.TransientGeometry

    Dim minXYZ As Point = bndBox.MinPoint
    Dim minXYmaxZ As Point = tg.CreatePoint(bndBox.MinPoint.X, bndBox.MinPoint.Y, bndBox.MaxPoint.Z)
    Dim minXmaxYZ As Point = tg.CreatePoint(bndBox.MinPoint.X, bndBox.MaxPoint.Y, bndBox.MaxPoint.Z)
    Dim minXZmaxY As Point = tg.CreatePoint(bndBox.MinPoint.X, bndBox.MaxPoint.Y, bndBox.MinPoint.Z)

    Dim maxXYZ As Point = bndBox.MaxPoint
    Dim maxXYminZ As Point = tg.CreatePoint(bndBox.MaxPoint.X, bndBox.MaxPoint.Y, bndBox.MinPoint.Z)
    Dim maxXZminY As Point = tg.CreatePoint(bndBox.MaxPoint.X, bndBox.MinPoint.Y, bndBox.MaxPoint.Z)
    Dim maxXminYZ As Point = tg.CreatePoint(bndBox.MaxPoint.X, bndBox.MinPoint.Y, bndBox.MinPoint.Z)

    lines.AddByTwoPoints(minXYZ, minXYmaxZ)
    lines.AddByTwoPoints(minXYZ, minXZmaxY)
    lines.AddByTwoPoints(minXZmaxY, minXmaxYZ)
    lines.AddByTwoPoints(minXYmaxZ, minXmaxYZ)

    lines.AddByTwoPoints(maxXYZ, maxXYminZ)
    lines.AddByTwoPoints(maxXYZ, maxXZminY)
    lines.AddByTwoPoints(maxXYminZ, maxXminYZ)
    lines.AddByTwoPoints(maxXZminY, maxXminYZ)

    lines.AddByTwoPoints(minXYZ, maxXminYZ)
    lines.AddByTwoPoints(minXYmaxZ, maxXZminY)
    lines.AddByTwoPoints(minXmaxYZ, maxXYZ)
    lines.AddByTwoPoints(minXZmaxY, maxXYminZ)
End Sub


' Calculates a tight bounding box around the input body.  An optional
' tolerance argument is available.  This specificies the tolerance in
' centimeters.  If not provided the best existing display mesh is used.
Public Function calculateTightBoundingBox(body As SurfaceBody, Optional Tolerance As Double = 0) As Box
    Try
        Dim vertCount As Integer
        Dim facetCount As Integer
        Dim vertCoords() As Double = {}
        Dim normVectors() As Double = {}
        Dim vertInds() As Integer = {}

        ' If the tolerance is zero, use the best display mesh available.
        If Tolerance <= 0 Then
            ' Get the best display mesh available.
            Dim tolCount As Long
            Dim tols() As Double = {}
            Call body.GetExistingFacetTolerances(tolCount, tols)
            Dim bestTol As Double
            bestTol = tols(0)
            For i As Integer = 1 To tolCount - 1
                If tols(i) < bestTol Then
                    bestTol = tols(i)
                End If
            Next

            body.GetExistingFacets(bestTol, vertCount, facetCount, vertCoords, normVectors, vertInds)
        Else
            ' Calculate a new mesh based on the input tolerance.
            body.CalculateFacets(Tolerance, vertCount, facetCount, vertCoords, normVectors, vertInds)
        End If

        Dim tg As TransientGeometry = body.Application.TransientGeometry

        ' Calculate the range of the mesh.
        Dim smallPnt As Point = tg.CreatePoint(vertCoords(0), vertCoords(1), vertCoords(2))
        Dim largePnt As Point = tg.CreatePoint(vertCoords(0), vertCoords(1), vertCoords(2))
        For i As Integer = 1 To vertCount - 1
            Dim vertX As Double = vertCoords(i * 3)
            Dim vertY As Double = vertCoords(i * 3 + 1)
            Dim vertZ As Double = vertCoords(i * 3 + 2)

            If vertX < smallPnt.X Then
                smallPnt.X = vertX
            End If

            If vertY < smallPnt.Y Then
                smallPnt.Y = vertY
            End If

            If vertZ < smallPnt.Z Then
                smallPnt.Z = vertZ
            End If

            If vertX > largePnt.X Then
                largePnt.X = vertX
            End If

            If vertY > largePnt.Y Then
                largePnt.Y = vertY
            End If

            If vertZ > largePnt.Z Then
                largePnt.Z = vertZ
            End If
        Next

        ' Create and return a Box as the result.
        Dim newBox As Box = tg.CreateBox()
        newBox.MinPoint = smallPnt
        newBox.MaxPoint = largePnt
        Return newBox
    Catch ex As Exception
        Return Nothing
    End Try
End Function

ngocson8335 · ‎10-09-2018

Thank you so much

Ngoc Son
Autodesk User

ngocson8335 · ‎10-09-2018

So I saw the code to use

ExtentsWidth

ExtentsLength

ExtentsHeight

to create a stock size for a part

SyntaxEditor Code Snippet (ilogic)

		Thickness = Measure.ExtentsLength
		
		If Measure.ExtentsWidth > Measure.ExtentsLength Then
			Width = Measure.ExtentsWidth
		Else
			Thickness = Measure.ExtentsWidth
			Width = Measure.ExtentsLength
		End If
		If Measure.ExtentsHeight > Width Then
			Lenght = Measure.ExtentsHeight
		Else
			If Measure.ExtentsHeight > Thickness Then
				Lenght = Width
				Width = Measure.ExtentsHeight
			Else
				Lenght = Width
				Width = Thickness
				Thickness = Measure.ExtentsHeight
			End If
			
		End If

How can I use it in Visual Studio? I try but can not! Please help me one more!

Thank you!

Ngoc Son
Autodesk User

bradeneuropeArthur · ‎10-09-2018

For Vb.net:

Public Sub DimensionComponentSimple()
dim ThisApplicationInv As Inventor.Application   
Try

        Dim oInventorDoc As Inventor.Document
        'oInventorDoc = ThisApplicationInv.ActiveDocument
        oInventorDoc = ThisApplicationInv.ActiveEditDocument

        
        If oInventorDoc.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Or oInventorDoc.DocumentType = DocumentTypeEnum.kPartDocumentObject Then

            Dim b As ComponentDefinition = Nothing

            If oInventorDoc.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then
                Dim OinventorDocToBeDim As Inventor.AssemblyDocument
                OinventorDocToBeDim = oInventorDoc
                b = OinventorDocToBeDim.ComponentDefinition
               End If

            If oInventorDoc.DocumentType = DocumentTypeEnum.kPartDocumentObject Then
                Dim OinventorDocToBeDim As Inventor.PartDocument
                OinventorDocToBeDim = oInventorDoc
                b = OinventorDocToBeDim.ComponentDefinition
                'b = CType(oInventorDoc, Inventor.PartDocument).ComponentDefinition
            End If


            Dim c As Box
            c = b.RangeBox

            Dim dmax As Point
            dmax = c.MaxPoint

            Dim dmin As Point
            dmin = c.MinPoint

            Dim dX As Decimal
            Dim dY As Decimal
            Dim dZ As Decimal

            Dim strLENGTH As Single
            Dim strWIDTH As Single
            Dim strTHICKNESS As Single

            dX = (dmax.X - dmin.X) * 10
            dY = (dmax.Y - dmin.Y) * 10
            dZ = (dmax.Z - dmin.Z) * 10

            dX = Math.Round(dX, DocPrec)
            dY = Math.Round(dY, DocPrec)
            dZ = Math.Round(dZ, DocPrec)

            Try
                
                If dX = dY Then
                    'MsgBox("x")
                    strLENGTH = dX '& " mm"
                    strWIDTH = dY
                    strTHICKNESS = dZ

                End If

                If dX = dZ Then
                    strLENGTH = dX '& " mm"
                    strWIDTH = dZ '& " mm"
                    strTHICKNESS = dY

                End If

                If dZ = dY Then
                    'MsgBox("x")
                    strLENGTH = dZ '& " mm"
                    strWIDTH = dY
                    strTHICKNESS = dX

                End If
               

                If dX > dY And dX > dZ Then
                    'MsgBox "x"
                    strLENGTH = dX
                    If dY > dZ Then
                        strWIDTH = dY
                        strTHICKNESS = dZ
                    Else
                        strWIDTH = dZ
                        strTHICKNESS = dY
                    End If
                End If
            Catch ex As Exception

            End Try

            If dY > dZ And dY > dX Then
                'MsgBox "y"
                strLENGTH = dY

                If dZ > dX Then
                    strWIDTH = dZ
                    strTHICKNESS = dX
                Else
                    strWIDTH = dX
                    strTHICKNESS = dZ
                End If
            End If

            If dZ > dX And dZ > dY Then
                'MsgBox "z"
                strLENGTH = dZ
                If dX > dY Then
                    strWIDTH = dX
                    strTHICKNESS = dY
                Else
                    strWIDTH = dY
                    strTHICKNESS = dX
                End If
            End If

            Dim LENGTH As [Property]
            Dim WIDTH As [Property]
            Dim THICKNESS As [Property]
            Dim StockNumber As [Property]
            Dim RoutineDimensioned As [Property]
            Dim DimensionDirty As Boolean = False

            Try
                LENGTH = oInventorDoc.PropertySets.Item("User Defined Properties").Add("", "LENGTH")
                If Not LENGTH.Expression = strLENGTH & " mm" Then '(dmax.X - dmin.X) * 10 & " mm"
                    LENGTH.Expression = strLENGTH & " mm"
                    DimensionDirty = True
                End If
            Catch ex As Exception
                LENGTH = oInventorDoc.PropertySets.Item("User Defined Properties").Item("LENGTH")
                If Not LENGTH.Expression = strLENGTH & " mm" Then '(dmax.X - dmin.X) * 10 & " mm"
                    LENGTH.Expression = strLENGTH & " mm"
                    DimensionDirty = True
                End If
            End Try
            Try
                WIDTH = oInventorDoc.PropertySets.Item("User Defined Properties").Add("", "WIDTH")
                If Not WIDTH.Expression = strWIDTH & " mm" Then '(dmax.Y - dmin.Y) * 10 & " mm"
                    WIDTH.Expression = strWIDTH & " mm"
                    DimensionDirty = True
                End If
            Catch ex As Exception
                WIDTH = oInventorDoc.PropertySets.Item("User Defined Properties").Item("WIDTH")
                If Not WIDTH.Expression = strWIDTH & " mm" Then '(dmax.Y - dmin.Y) * 10 & " mm"
                    WIDTH.Expression = strWIDTH & " mm"
                    DimensionDirty = True
                End If
            End Try

            Try
                THICKNESS = oInventorDoc.PropertySets.Item("User Defined Properties").Add("", "THICKNESS")
                If Not THICKNESS.Expression = strTHICKNESS & " mm" Then '(dmax.z - dmin.z) * 10 & " mm"
                    THICKNESS.Expression = strTHICKNESS & " mm"
                    DimensionDirty = True
                End If
            Catch ex As Exception
                THICKNESS = oInventorDoc.PropertySets.Item("User Defined Properties").Item("THICKNESS")
                If Not THICKNESS.Expression = strTHICKNESS & " mm" Then '(dmax.z - dmin.z) * 10 & " mm"
                    THICKNESS.Expression = strTHICKNESS & " mm"
                    DimensionDirty = True
                End If
            End Try

            Try
                StockNumber = oInventorDoc.PropertySets.Item("Design Tracking Properties").Item("Stock Number")

                If Not StockNumber.Expression = "=<Width> x <Thickness>" Then
                    StockNumber.Expression = "=<Width> x <Thickness>"
                End If

            Catch ex As Exception
                MsgBox("Stock Number Error: " & ex.Message)
            End Try

            'Only show message if needed on dirty property
            If oInventorDoc.Dirty = True Then

                If DimensionDirty = True Then

                    msgbox = "Dimensions of " & oInventorDoc.DisplayName & " :" & LENGTH.Expression & " x " & WIDTH.Expression & " x " & THICKNESS.Expression
                End If
            End If

        End If
            Catch ex As Exception

        MsgBox("Error Dimensioning: " & ex.Message)
    End Try

End Sub

ngocson8335 · ‎10-09-2018

Hi Bradeneurope,

Thank you for your help.

Manymany Thanks!

Ngoc Son
Autodesk User

ngocson8335 · ‎10-10-2018

Hi Bradeneurope,

Please help me. Now I can calculate the stock number for parts in the context Assembly. But I have a problem is I can not finish edit part in assembly by code.

Can you suggest me another way that no need to edit part in the context ass, please?

Here is the code:

Imports System
Imports System.Runtime.InteropServices
Imports Inventor

Public Class Form1

Dim invApp As Inventor.Application
Dim partDoc As Inventor.PartDocument
Dim assemblyDoc As Inventor.AssemblyDocument

Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click

invApp = Marshal.GetActiveObject("Inventor.Application")

assemblyDoc = invApp.ActiveEditDocument
Dim assemblyDef As Inventor.AssemblyComponentDefinition
assemblyDef = assemblyDoc.ComponentDefinition

Dim oComponentOccurrence As Inventor.ComponentOccurrence
For Each oComponentOccurrence In assemblyDef.Occurrences

Dim oBox As Inventor.Box
oBox = oComponentOccurrence.RangeBox

Dim dmax As Point
dmax = oBox.MaxPoint

Dim dmin As Point
dmin = oBox.MinPoint

Dim dX As Decimal
Dim dY As Decimal
Dim dZ As Decimal

Dim strLength As Single
Dim strWidth As Single
Dim strThickness As Single

dX = (dmax.X - dmin.X) * 10
dY = (dmax.Y - dmin.Y) * 10
dZ = (dmax.Z - dmin.Z) * 10

Dim docPrec As Integer

dX = Math.Round(dX, docPrec)
dY = Math.Round(dY, docPrec)
dZ = Math.Round(dZ, docPrec)

Try

If dX = dY Then
strLength = dX
strWidth = dY
strThickness = dZ
End If

If dY = dZ Then
strLength = dX
strWidth = dZ
strThickness = dY

End If

If dX = dZ Then
strLength = dZ
strWidth = dY
strThickness = dX
End If

If dX > dY And dX > dZ Then
strLength = dX
If dY > dZ Then
strWidth = dY
strThickness = dZ
Else
strWidth = dZ
strThickness = dY
End If

End If
Catch ex As Exception

End Try

If dY > dX And dY > dZ Then
strLength = dY
If dX > dZ Then
strWidth = dX
strThickness = dZ
Else
strWidth = dZ
strThickness = dX
End If
End If

If dZ > dX And dZ > dY Then
strLength = dZ
If dX > dY Then
strWidth = dX
strThickness = dY
Else
strWidth = dY
strThickness = dX
End If
End If

MsgBox("Stock Number of " & oComponentOccurrence.Name & "is: " & strLength & " mm x " & strWidth & " mm x " & strThickness & " mm")

oComponentOccurrence.Edit()

Dim length As [Property]
Dim dimensiondirty As Boolean = False

partDoc = invApp.ActiveEditDocument

Try
length = partDoc.PropertySets.Item("User Defined Properties").Add("", "Length")

If Not length.Expression = strLength & " mm" Then

length.Expression = strLength & " mm"
dimensiondirty = True
End If

Catch ex As Exception

length = partDoc.PropertySets.Item("User Defined Properties").Item("Length")

If Not length.Expression = strLength & " mm" Then

length.Expression = strLength & " mm"
dimensiondirty = True
End If

End Try

'...

Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load

End Sub

End Class

Thank you so much

Ngoc Son

Inventor's User

Ngoc Son
Autodesk User

Anonymous · ‎03-27-2021

Hello. I am new to the subject of Inventor VBA programming, and I also do not understand how to make the "calcualteTightBoundingBox(Body)" in the following code

(source: https://modthemachine.typepad.com/my_weblog/2017/06/getting-the-overall-size-of-parts.html) :

Public Sub TestTightBoundingBox()
    ' Have a body selected.
    Dim body As SurfaceBody
    Set body = ThisApplication.CommandManager.Pick(kPartBodyFilter, "Select the body.")
    
    ' Call the function to get the tight bounding box.
    Dim bndBox As Box
    Set bndBox = calculateTightBoundingBox(body)
        
    ' Draw the bounding box using a 3D sketch.
    Dim partDoc As PartDocument
    Set partDoc = ThisApplication.ActiveDocument
    Dim sk As Sketch3D
    Set sk = partDoc.ComponentDefinition.Sketches3D.Add()
    Dim lines As SketchLines3D
    Set lines = sk.SketchLines3D

    Dim tg As TransientGeometry
    Set tg = ThisApplication.TransientGeometry
    
    Dim minXYZ As Point
    Dim minXYmaxZ As Point
    Dim minXmaxYZ As Point
    Dim minXZmaxY As Point
    Set minXYZ = bndBox.MinPoint
    Set minXYmaxZ = tg.CreatePoint(bndBox.MinPoint.x, bndBox.MinPoint.y, bndBox.MaxPoint.Z)
    Set minXmaxYZ = tg.CreatePoint(bndBox.MinPoint.x, bndBox.MaxPoint.y, bndBox.MaxPoint.Z)
    Set minXZmaxY = tg.CreatePoint(bndBox.MinPoint.x, bndBox.MaxPoint.y, bndBox.MinPoint.Z)
    
    Dim maxXYZ As Point
    Dim maxXYminZ As Point
    Dim maxXZminY As Point
    Dim maxXminYZ As Point
    Set maxXYZ = bndBox.MaxPoint
    Set maxXYminZ = tg.CreatePoint(bndBox.MaxPoint.x, bndBox.MaxPoint.y, bndBox.MinPoint.Z)
    Set maxXZminY = tg.CreatePoint(bndBox.MaxPoint.x, bndBox.MinPoint.y, bndBox.MaxPoint.Z)
    Set maxXminYZ = tg.CreatePoint(bndBox.MaxPoint.x, bndBox.MinPoint.y, bndBox.MinPoint.Z)
    
    Call lines.AddByTwoPoints(minXYZ, minXYmaxZ)
    Call lines.AddByTwoPoints(minXYZ, minXZmaxY)
    Call lines.AddByTwoPoints(minXZmaxY, minXmaxYZ)
    Call lines.AddByTwoPoints(minXYmaxZ, minXmaxYZ)
    
    Call lines.AddByTwoPoints(maxXYZ, maxXYminZ)
    Call lines.AddByTwoPoints(maxXYZ, maxXZminY)
    Call lines.AddByTwoPoints(maxXYminZ, maxXminYZ)
    Call lines.AddByTwoPoints(maxXZminY, maxXminYZ)
    
    Call lines.AddByTwoPoints(minXYZ, maxXminYZ)
    Call lines.AddByTwoPoints(minXYmaxZ, maxXZminY)
    Call lines.AddByTwoPoints(minXmaxYZ, maxXYZ)
    Call lines.AddByTwoPoints(minXZmaxY, maxXYminZ)
End Sub

Ralf_Krieg · ‎03-27-2021

Hello

There are the codetags missing around the function, so it looks a little confusing. The complete VBA Code is

Public Sub TestTightBoundingBox()
    ' Have a body selected.
    Dim body As SurfaceBody
    Set body = ThisApplication.CommandManager.Pick(kPartBodyFilter, "Select the body.")
    
    ' Call the function to get the tight bounding box.
    Dim bndBox As Box
    Set bndBox = calculateTightBoundingBox(body)
        
    ' Draw the bounding box using a 3D sketch.
    Dim partDoc As PartDocument
    Set partDoc = ThisApplication.ActiveDocument
    Dim sk As Sketch3D
    Set sk = partDoc.ComponentDefinition.Sketches3D.Add()
    Dim lines As SketchLines3D
    Set lines = sk.SketchLines3D

    Dim tg As TransientGeometry
    Set tg = ThisApplication.TransientGeometry
    
    Dim minXYZ As Point
    Dim minXYmaxZ As Point
    Dim minXmaxYZ As Point
    Dim minXZmaxY As Point
    Set minXYZ = bndBox.MinPoint
    Set minXYmaxZ = tg.CreatePoint(bndBox.MinPoint.x, bndBox.MinPoint.y, bndBox.MaxPoint.Z)
    Set minXmaxYZ = tg.CreatePoint(bndBox.MinPoint.x, bndBox.MaxPoint.y, bndBox.MaxPoint.Z)
    Set minXZmaxY = tg.CreatePoint(bndBox.MinPoint.x, bndBox.MaxPoint.y, bndBox.MinPoint.Z)
    
    Dim maxXYZ As Point
    Dim maxXYminZ As Point
    Dim maxXZminY As Point
    Dim maxXminYZ As Point
    Set maxXYZ = bndBox.MaxPoint
    Set maxXYminZ = tg.CreatePoint(bndBox.MaxPoint.x, bndBox.MaxPoint.y, bndBox.MinPoint.Z)
    Set maxXZminY = tg.CreatePoint(bndBox.MaxPoint.x, bndBox.MinPoint.y, bndBox.MaxPoint.Z)
    Set maxXminYZ = tg.CreatePoint(bndBox.MaxPoint.x, bndBox.MinPoint.y, bndBox.MinPoint.Z)
    
    Call lines.AddByTwoPoints(minXYZ, minXYmaxZ)
    Call lines.AddByTwoPoints(minXYZ, minXZmaxY)
    Call lines.AddByTwoPoints(minXZmaxY, minXmaxYZ)
    Call lines.AddByTwoPoints(minXYmaxZ, minXmaxYZ)
    
    Call lines.AddByTwoPoints(maxXYZ, maxXYminZ)
    Call lines.AddByTwoPoints(maxXYZ, maxXZminY)
    Call lines.AddByTwoPoints(maxXYminZ, maxXminYZ)
    Call lines.AddByTwoPoints(maxXZminY, maxXminYZ)
    
    Call lines.AddByTwoPoints(minXYZ, maxXminYZ)
    Call lines.AddByTwoPoints(minXYmaxZ, maxXZminY)
    Call lines.AddByTwoPoints(minXmaxYZ, maxXYZ)
    Call lines.AddByTwoPoints(minXZmaxY, maxXYminZ)
End Sub


' Calculates a tight bounding box around the input body.  An optional
' tolerance argument is available.  This specificies the tolerance in
' centimeters.  If not provided the best existing display mesh is used.
Public Function calculateTightBoundingBox(body As SurfaceBody, Optional Tolerance As Double = 0) As Box
    On Error GoTo ErrorFound
       
    Dim vertCount As Long
    Dim facetCount As Long
    Dim vertCoords() As Double
    Dim normVectors() As Double
    Dim vertInds() As Long
       
    ' If the tolerance is zero, use the best display mesh available.
    If Tolerance <= 0 Then
        ' Get the best display mesh available.
        Dim tolCount As Long
        Dim tols() As Double
        Call body.GetExistingFacetTolerances(tolCount, tols)
        Dim i As Integer
        Dim bestTol As Double
        bestTol = tols(0)
        For i = 1 To tolCount - 1
            If tols(i) < bestTol Then
                bestTol = tols(i)
            End If
        Next
       
        Call body.GetExistingFacets(bestTol, vertCount, facetCount, vertCoords, normVectors, vertInds)
    Else
        ' Calculate a new mesh based on the input tolerance.
        Call body.CalculateFacets(Tolerance, vertCount, facetCount, vertCoords, normVectors, vertInds)
    End If

    Dim tg As TransientGeometry
    Set tg = ThisApplication.TransientGeometry
   
    ' Calculate the range of the mesh.
    Dim smallPnt As Point
    Dim largePnt As Point
    Set smallPnt = tg.CreatePoint(vertCoords(0), vertCoords(1), vertCoords(2))
    Set largePnt = tg.CreatePoint(vertCoords(0), vertCoords(1), vertCoords(2))
   
    For i = 1 To vertCount - 1
        Dim vertX As Double
        Dim vertY As Double
        Dim vertZ As Double
        vertX = vertCoords(i * 3)
        vertY = vertCoords(i * 3 + 1)
        vertZ = vertCoords(i * 3 + 2)
       
        If vertX < smallPnt.x Then
            smallPnt.x = vertX
        End If
           
        If vertY < smallPnt.y Then
            smallPnt.y = vertY
        End If
           
        If vertZ < smallPnt.Z Then
            smallPnt.Z = vertZ
        End If
       
        If vertX > largePnt.x Then
            largePnt.x = vertX
        End If
           
        If vertY > largePnt.y Then
            largePnt.y = vertY
        End If
           
        If vertZ > largePnt.Z Then
            largePnt.Z = vertZ
        End If
    Next
   
    ' Create and return a Box as the result.
    Set calculateTightBoundingBox = tg.CreateBox()
    calculateTightBoundingBox.MinPoint = smallPnt
    calculateTightBoundingBox.MaxPoint = largePnt
    Exit Function
ErrorFound:
    Set calculateTightBoundingBox = Nothing
    Exit Function
End Function

R. Krieg
RKW Solutions GmbH
www.rkw-solutions.com

Can't call the function to get the tight bounding box

Can't call the function to get the tight bounding box

Can't call the function to get the tight bounding box

Forums Links

Post to forums