Creating a bounding box arround a solid

Hi,
I found this code in Engtips this may useful for you....
and it'll be great help if anyone modifies to allow to user defined direction for X and Y

Option Strict Off

Imports System

Imports NXOpen
Imports NXOpen.UI
Imports NXOpen.Utilities
Imports NXOpen.UF

Module make_bounding_block_of_selected_body_relative_to_wcs

Dim s As Session = Session.GetSession()
Dim ufs As UFSession = UFSession.GetUFSession()
Dim lw As ListingWindow = s.ListingWindow()

Sub Main()

Dim a_body As NXOpen.Tag = NXOpen.Tag.Null
Dim csys As NXOpen.Tag = NXOpen.Tag.Null
Dim target As NXOpen.Tag = NXOpen.Tag.Null
Dim blockFeature As NXOpen.Tag = NXOpen.Tag.Null

Dim min_corner(2) As Double
Dim directions(2, 2) As Double
Dim distances(2) As Double
Dim edge_len(2) As String

While select_a_body(a_body) = Selection.Response.Ok

ufs.Csys.AskWcs(csys)

ufs.Modl.AskBoundingBoxExact(a_body, csys, min_corner, directions, _
distances)

lw.Open()

lw.WriteLine("Min_corner: " & _
min_corner(0).ToString & ", " & _
min_corner(1).ToString & ", " & _
min_corner(2).ToString & ", ")

lw.WriteLine("X direction: " & _
directions(0, 0).ToString & ", " & _
directions(0, 1).ToString & ", " & _
directions(0, 2).ToString & ", ")
lw.WriteLine("X distance: " & _
distances(0).ToString)

lw.WriteLine("Y direction: " & _
directions(1, 0).ToString & ", " & _
directions(1, 1).ToString & ", " & _
directions(1, 2).ToString & ", ")
lw.WriteLine("Y distance: " & _
distances(1).ToString)

lw.WriteLine("Z direction: " & _
directions(2, 0).ToString & ", " & _
directions(2, 1).ToString & ", " & _
directions(2, 2).ToString & ", ")
lw.WriteLine("Z distance: " & _
distances(2).ToString)

edge_len(0) = distances(0).ToString()
edge_len(1) = distances(1).ToString()
edge_len(2) = distances(2).ToString()

ufs.Modl.CreateBlock(FeatureSigns.Nullsign, _
target, min_corner, edge_len, blockFeature)
End While

End Sub

Function select_a_body(ByRef a_body As NXOpen.Tag) As Selection.Response

Dim message As String = "Select a body"
Dim title As String = "Select a body"
Dim scope As Integer = UFConstants.UF_UI_SEL_SCOPE_ANY_IN_ASSEMBLY
Dim response As Integer

Dim view As NXOpen.Tag
Dim cursor(2) As Double
Dim ip As UFUi.SelInitFnT = AddressOf body_init_proc

ufs.Ui.LockUgAccess(UFConstants.UF_UI_FROM_CUSTOM)

Try
ufs.Ui.SelectWithSingleDialog(message, title, scope, ip, _
Nothing, response, a_body, cursor, view)
Finally
ufs.Ui.UnlockUgAccess(UFConstants.UF_UI_FROM_CUSTOM)
End Try

If response <> UFConstants.UF_UI_OBJECT_SELECTED And _
response <> UFConstants.UF_UI_OBJECT_SELECTED_BY_NAME Then
Return Selection.Response.Cancel
Else
ufs.Disp.SetHighlight(a_body, 0)
Return Selection.Response.Ok
End If

End Function

Function body_init_proc(ByVal select_ As IntPtr, _
ByVal userdata As IntPtr) As Integer

Dim num_triples As Integer = 1
Dim mask_triples(0) As UFUi.Mask
mask_triples(0).object_type = UFConstants.UF_solid_type
mask_triples(0).object_subtype = UFConstants.UF_solid_body_subtype
mask_triples(0).solid_type = UFConstants.UF_UI_SEL_FEATURE_BODY

ufs.Ui.SetSelMask(select_, _
UFUi.SelMaskAction.SelMaskClearAndEnableSpecific, _
num_triples, mask_triples)
Return UFConstants.UF_UI_SEL_SUCCESS

End Function

Public Function GetUnloadOption(ByVal dummy As String) As Integer

GetUnloadOption = UFConstants.UF_UNLOAD_IMMEDIATELY

End Function

End Module

It's not a good idea to try to combine the bodies, you just want to "combine" their boxes. In other words, you want a single box that encloses all the boxes of the individual bodies. If you have access to SNAP, there is a function Snap.Geom.Box3d.Combine that does exactly what you need. If you don't have SNAP, then you just need to take the minimum and maximum XYZ coordinates of the individual boxes.

After Creating the blockfeature I am unable to add it to a list It is throwing Object reference error. But for individual Body (After Line1) it is running perfectly. Also can you help me to tag the United body which is created by Boolienbuilder1. It is input for Line1
Dim theBodies() As Body = Nothing

theBodies = AskAllBodies(MyPart).ToArray
' MsgBox(theBodies.Length.ToString)
' Catch ex As NXException
' lw.WriteLine(Partno & ex.ErrorCode.ToString & ex.Message.ToString)
' End Try

'Measure Boundingbox Dimensions

Dim csys As Tag = Tag.Null
Dim min_corner(2) As Double
Dim directions(2, 2) As Double
Dim distances(2) As Double
Dim edge_len(2) As String
Dim target As Tag = Tag.Null
Dim blockFeature As Tag = Tag.Null
ufs.Csys.AskWcs(csys)
Dim XValue As String = Nothing
Dim YValue As String = Nothing
Dim ZValue As String = Nothing

Dim Mybodies As NXOpen.Tag = Nothing
Dim i As Integer = Nothing
Dim j As Integer = Nothing
Dim Blocklist As List(Of Body) = Nothing
j = theBodies.Length
If j = 1 Then
Mybodies = theBodies(0).Tag
GoTo line1
ElseIf j > 1 Then
For i = 0 To j - 1
Mybodies = theBodies(i).Tag
Try
ufs.Modl.AskBoundingBoxExact(Mybodies, csys, min_corner, directions, distances)
edge_len(0) = distances(0).ToString()
edge_len(1) = distances(1).ToString()
edge_len(2) = distances(2).ToString()
ufs.Modl.CreateBlock(FeatureSigns.Nullsign, target, min_corner, edge_len, blockFeature)
Dim tagobj As TaggedObject = Utilities.NXObjectManager.Get(blockFeature)
Dim sblock As Features.Block = tagobj
Dim sBody As Body = sblock.GetBodies(0)
Blocklist.Add(sBody)
Catch ex As NXException
lw.WriteLine(Partno & ex.ErrorCode & ": Bound Box Creation Error for individual solids" & ex.Message.ToString)
End Try
Next
Try
Dim nullFeatures_BooleanFeature As Features.BooleanFeature = Nothing
Dim booleanBuilder1 As Features.BooleanBuilder
booleanBuilder1 = MyPart.Features.CreateBooleanBuilderUsingCollector(nullFeatures_BooleanFeature)
Dim scCollector1 As ScCollector
scCollector1 = booleanBuilder1.ToolBodyCollector
booleanBuilder1.Tolerance = 0.01
booleanBuilder1.Operation = Features.Feature.BooleanType.Unite
Dim added1 As Boolean
added1 = booleanBuilder1.Targets.Add(Blocklist(0))
Blocklist.Remove(Blocklist(0))
Dim Newblocklist1() As Body = Blocklist.ToArray
Dim scCollector2 As ScCollector
scCollector2 = MyPart.ScCollectors.CreateCollector()
Dim bodyDumbRule1 As BodyDumbRule
bodyDumbRule1 = MyPart.ScRuleFactory.CreateRuleBodyDumb(Newblocklist1)
Dim rules1(0) As SelectionIntentRule
rules1(0) = bodyDumbRule1
scCollector2.ReplaceRules(rules1, False)
booleanBuilder1.ToolBodyCollector = scCollector2
Dim nXObject1 As object
nXObject1 = booleanBuilder1.Commit()
booleanBuilder1.Destroy()

Catch EX As NXException
lw.WriteLine(Partno & ": Unite bodies error" & EX.Message.ToString)
End Try
' lw.WriteLine("there are " & Bodieslist.Count & " solid bodies on Part)
ElseIf j = 0 Then
lw.WriteLine(Partno & ": Part has no solid bodies. Please Check the bounding box Dimensions manaully")
GoTo line2
End If

Line1:
Try
ufs.Modl.AskBoundingBoxExact(Mybodies, csys, min_corner, directions, distances)
Dim TrimX() As String = Split(distances(0).ToString, ".", 2)
Dim TrimY() As String = Split(distances(1).ToString, ".", 2)
Dim TrimZ() As String = Split(distances(2).ToString, ".", 2)
XValue = TrimX(0) & "." & Left(TrimX(1), 3) & " mm"
YValue = TrimY(0) & "." & Left(TrimY(1), 3) & " mm"
ZValue = TrimZ(0) & "." & Left(TrimZ(1), 3) & " mm"
Catch ex As Exception
lw.WriteLine(Partno & ": Bound Box Dimensional Error-" & ex.Message.ToString)
XValue = distances(0).ToString
YValue = distances(1).ToString
ZValue = distances(2).ToString
End Try

edge_len(0) = distances(0).ToString()
edge_len(1) = distances(1).ToString()
edge_len(2) = distances(2).ToString()
Try
ufs.Modl.CreateBlock(FeatureSigns.Nullsign, target, min_corner, edge_len, blockFeature)
Dim Myblock As TaggedObject = Utilities.NXObjectManager.Get(blockFeature)
Dim Bbox As Features.Block = Myblock
Dim Transparentbody As Body = Bbox.GetBodies(0)
Transparentbody.Color = 5

Dim displayModification1 As DisplayModification
displayModification1 = theSession.DisplayManager.NewDisplayModification()
displayModification1.ApplyToAllFaces = True
displayModification1.ApplyToOwningParts = False
displayModification1.NewWidth = DisplayableObject.ObjectWidth.Two
displayModification1.NewTranslucency = 100
Dim objects1(0) As DisplayableObject
objects1(0) = Transparentbody
displayModification1.Apply(objects1)
displayModification1.Dispose()
Transparentbody.RedisplayObject()
Catch ex As NXException
lw.WriteLine(Partno & ": " & ex.ErrorCode & "-" & ex.Message.ToString & "Unable to Create Transparent Body")
End Try