03-27-2021
11:54 AM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
03-27-2021
11:54 AM
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