Bounding box dimensions, based on selected solid and selected csys

[ving]

thread561-366113

Hi, I found this excellent code from cowski. Since my programing skills are very limited I ask you here if it is possible to make some changes / improvements to it.

1. Is it possible to have the dimensions (bounds) written to only one attribute?
2. Is it possible to have it sorted like this: smallest dimension X middle dimension X largest dimension ?
3. Is possible to round all values up to the closest millimetre. instead of this 50,1 x 100,5 x 200,9 you get 51 x 101 x 201 ?
4. If the (outer) geometry is a cylinder, is it then possible to report it like this Ø diameter X length ?

See code below

ving

CODE
'NXJournaling.com
'June 9, 2014
'journal to report bounding box dimensions based on selected solid and selected csys
'dimensions, vector directions, and timestamp will be assigned to part attributes

'for NX 8 and above only

Option Strict Off
Imports System
Imports NXOpen
Imports NXOpen.UF
Imports NXOpenUI

Module Module2

Dim theSession As Session = Session.GetSession()
Dim workPart As Part = theSession.Parts.Work

Sub Main()

Dim ufs As UFSession = UFSession.GetUFSession()
Dim displayPart As Part = theSession.Parts.Display
Dim lw As ListingWindow = theSession.ListingWindow
lw.Open()

Dim bbox(5) As Double
Dim dblAcc_Value(11) As Double
Dim dblMass_Props(46) As Double
Dim dblStats(12) As Double
Dim strOutput As String
Dim boundX As Double
Dim boundY As Double
Dim boundZ As Double
Dim minCorner(2) As Double
Dim boxDirections(2, 2) As Double
Dim boxDistances(2) As Double
Dim useACS As Boolean = False
Dim dirX As New Vector3d(1, 0, 0)
Dim dirY As New Vector3d(0, 1, 0)
Dim dirZ As New Vector3d(0, 0, 1)

Dim solid1 As Body
If SelectSolid("Select solid", solid1) = Selection.Response.Cancel Then
Return
End If

Dim tagList(0) As NXOpen.Tag
tagList(0) = solid1.Tag

Dim myCsys As CoordinateSystem = Nothing
If SelectCSYS("Select a saved CSYS, 'OK' to use ACS", myCsys) = Selection.Response.Cancel Then
Exit Sub
End If

If IsNothing(myCsys) Then
useACS = True

dirX.X = 1
dirX.Y = 0
dirX.Z = 0

dirY.X = 0
dirY.Y = 1
dirY.Z = 0

dirZ.X = 0
dirZ.Y = 0
dirZ.Z = 1

Else
With myCsys.Orientation.Element

dirX.X = .Xx
dirX.Y = .Xy
dirX.Z = .Xz

dirY.X = .Yx
dirY.Y = .Yy
dirY.Z = .Yz

dirZ.X = .Zx
dirZ.Y = .Zy
dirZ.Z = .Zz

End With

End If


'get volume
dblAcc_Value(0) = 0.999
'AskMassProps3d(in_Tags(),in_num_objs,in_type,in_units,in_density,in_accuracy,in_accuracy_values(),out_mass_props(),out_stats())
ufs.Modl.AskMassProps3d(tagList, 1, 1, 1, 0.0375, 1, dblAcc_Value, dblMass_Props, dblStats)
strOutput = "Surface Area: " & dblMass_Props(0) & vbCrLf
strOutput = strOutput & "Volume: " & dblMass_Props(1) & vbCrLf
strOutput = strOutput & "Mass: " & dblMass_Props(2) & vbCrLf
strOutput = strOutput & "COG: " & dblMass_Props(3) & ", " & dblMass_Props(4) & ", " & dblMass_Props(5) & vbCrLf
strOutput = strOutput & "Density: " & dblMass_Props(46)

If useACS Then
'get solid body bounding box extents aligned to absolute csys
ufs.Modl.AskBoundingBox(solid1.Tag, bbox)
boundX = bbox(3) - bbox(0)
boundY = bbox(4) - bbox(1)
boundZ = bbox(5) - bbox(2)

Else
'get solid body bounding box extents aligned to work csys (pass null tag to use work csys)
ufs.Modl.AskBoundingBoxAligned(solid1.Tag, myCsys.Tag, expand:=False, min_corner:=minCorner, directions:=boxDirections, distances:=boxDistances)
boundX = boxDistances(0)
boundY = boxDistances(1)
boundZ = boxDistances(2)

End If

AttributeLength("Bounds X", boundX)
AttributeLength("Bounds Y", boundY)
AttributeLength("Bounds Z", boundZ)

AttributeDirection("Direction X.X", dirX.X)
AttributeDirection("Direction X.Y", dirX.Y)
AttributeDirection("Direction X.Z", dirX.Z)

AttributeDirection("Direction Y.X", dirY.X)
AttributeDirection("Direction Y.Y", dirY.Y)
AttributeDirection("Direction Y.Z", dirY.Z)

AttributeDirection("Direction Z.X", dirZ.X)
AttributeDirection("Direction Z.Y", dirZ.Y)
AttributeDirection("Direction Z.Z", dirZ.Z)

AttributeTimeStamp()

End Sub

'**********************************************************
Function SelectSolid(ByVal prompt As String, ByRef selObj As TaggedObject) As Selection.Response

Dim theUI As UI = UI.GetUI
Dim title As String = "Select a solid body"
Dim includeFeatures As Boolean = False
Dim keepHighlighted As Boolean = False
Dim selAction As Selection.SelectionAction = Selection.SelectionAction.ClearAndEnableSpecific
Dim cursor As Point3d
Dim scope As Selection.SelectionScope = Selection.SelectionScope.WorkPart
Dim selectionMask_array(0) As Selection.MaskTriple

With selectionMask_array(0)
.Type = UFConstants.UF_solid_type
.SolidBodySubtype = UFConstants.UF_UI_SEL_FEATURE_BODY
End With

Dim resp As Selection.Response = theUI.SelectionManager.SelectTaggedObject(prompt, _
title, scope, selAction, _
includeFeatures, keepHighlighted, selectionMask_array, _
selObj, cursor)
If resp = Selection.Response.ObjectSelected OrElse resp = Selection.Response.ObjectSelectedByName Then
Return Selection.Response.Ok
Else
Return Selection.Response.Cancel
End If

End Function

'*******************

Function SelectCSYS(ByVal prompt As String, ByRef csysObj As CoordinateSystem) As Selection.Response

Dim theUI As UI = UI.GetUI
Dim title As String = prompt
Dim includeFeatures As Boolean = False
Dim keepHighlighted As Boolean = False
Dim selAction As Selection.SelectionAction = Selection.SelectionAction.ClearAndEnableSpecific
Dim cursor As Point3d
Dim scope As Selection.SelectionScope = Selection.SelectionScope.WorkPart
Dim selectionMask_array(0) As Selection.MaskTriple

With selectionMask_array(0)
.Type = UFConstants.UF_coordinate_system_type
.Subtype = UFConstants.UF_all_subtype
End With

Dim resp As Selection.Response = theUI.SelectionManager.SelectTaggedObject(prompt, _
title, scope, selAction, _
includeFeatures, keepHighlighted, selectionMask_array, _
csysObj, cursor)

If resp = Selection.Response.ObjectSelected OrElse _
resp = Selection.Response.ObjectSelectedByName OrElse _
resp = Selection.Response.Ok Then
Return Selection.Response.Ok
Else
Return Selection.Response.Cancel
End If

End Function

Sub AttributeLength(ByVal theName As String, ByVal theLength As Double)

Dim objects1(0) As NXObject
objects1(0) = workPart
Dim attributePropertiesBuilder1 As AttributePropertiesBuilder
attributePropertiesBuilder1 = theSession.AttributeManager.CreateAttributePropertiesBuilder(workPart, objects1, AttributePropertiesBuilder.OperationType.None)

With attributePropertiesBuilder1

.IsArray = False
.DataType = AttributePropertiesBaseBuilder.DataTypeOptions.Number
.SetAttributeObjects(objects1)

If workPart.PartUnits = BasePart.Units.Inches Then
.Units = "Inch"
Else
.Units = "Millimeter"
End If

.Category = "BoundingBox"
.Title = theName
.NumberValue = theLength

Dim nXObject1 As NXObject
nXObject1 = .Commit()

End With

attributePropertiesBuilder1.Destroy()

End Sub

Sub AttributeDirection(ByVal theName As String, ByVal theDirection As Double)

Dim objects6(0) As NXObject
objects6(0) = workPart
Dim attributePropertiesBuilder2 As AttributePropertiesBuilder
attributePropertiesBuilder2 = theSession.AttributeManager.CreateAttributePropertiesBuilder(workPart, objects6, AttributePropertiesBuilder.OperationType.None)

With attributePropertiesBuilder2
.IsArray = False
.DataType = AttributePropertiesBaseBuilder.DataTypeOptions.Number
.SetAttributeObjects(objects6)
.Category = "BoundingBox"
.Title = theName
.Units = ""
.NumberValue = theDirection

Dim nXObject4 As NXObject
nXObject4 = attributePropertiesBuilder2.Commit()

End With

attributePropertiesBuilder2.Destroy()

End Sub

Sub AttributeTimeStamp()

Dim myDateTime As DateTime = Now

Dim objects11(0) As NXObject
objects11(0) = workPart
Dim attributePropertiesBuilder3 As AttributePropertiesBuilder
attributePropertiesBuilder3 = theSession.AttributeManager.CreateAttributePropertiesBuilder(workPart, objects11, AttributePropertiesBuilder.OperationType.None)
With attributePropertiesBuilder3
.IsArray = False
.DataType = AttributePropertiesBaseBuilder.DataTypeOptions.Date
.Category = "BoundingBox"
.Title = "TimeStamp"
.DateValue.DateItem.Day = myDateTime.Day - 1
.DateValue.DateItem.Month = myDateTime.Month - 1
.DateValue.DateItem.Year = myDateTime.Year.ToString
.DateValue.DateItem.Time = myDateTime.ToString("HH:mm:ss")

.SetAttributeObjects(objects11)

Dim nXObject7 As NXObject
nXObject7 = .Commit()

End With

attributePropertiesBuilder3.Destroy()

End Sub

Public Function GetUnloadOption(ByVal dummy As String) As Integer

'Unloads the image when the NX session terminates
GetUnloadOption = NXOpen.Session.LibraryUnloadOption.AtTermination

'----Other unload options-------
'Unloads the image immediately after execution within NX
'GetUnloadOption = NXOpen.Session.LibraryUnloadOption.Immediately

'Unloads the image explicitly, via an unload dialog
'GetUnloadOption = NXOpen.Session.LibraryUnloadOption.Explicitly
'-------------------------------

End Function

End Module