Announcements
Attention for Customers without Multi-Factor Authentication or Single Sign-On - OTP Verification rolls out April 2025. Read all about it here.
Ralf_Krieg
in reply to: ngocson8335

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
www.rkw-solutions.com