Measure XYZ from USC and convert to iproperties

[syafiqfarhan]

Hi, I facing some problems, I did manage to get the information that I want using code 1 as below

CODE 1

Dim partDoc As PartDocument = ThisApplication.ActiveDocument
'get 3d solid
Dim sb As SurfaceBody = partDoc.ComponentDefinition.SurfaceBodies.Item(1)
'get custom user coordinate system
Dim ucs As UserCoordinateSystem = partDoc.ComponentDefinition.UserCoordinateSystems(1)
'create a list of points (for sorting)
Dim vPoints As New List(Of Point)
'get the transformation matrix from the usc (what it takes to translate from user ucs to origin)
Dim mat As Matrix = ucs.Transformation
'invert the matrix (what it takes to translate from origin to user ucs)
mat.Invert()
'cycle through all the points
For Each vert As Vertex In sb.Vertices
    'get the point data from the vertex
    Dim p As Point = vert.Point
    'invert translate the point data (from origin to user ucs)
    p.TransformBy(mat)
    'add translated point to collection
    vPoints.Add(p)
Next
Dim tg = ThisApplication.TransientGeometry
'create empty min and max points
Dim minPoint As Point = tg.CreatePoint(0, 0, 0)
Dim maxPoint As Point = tg.CreatePoint(0, 0, 0)
'sort points based on x values, and get lowest and highest value
vPoints.Sort(Function(x, y) x.X.CompareTo(y.X))
minPoint.X = vPoints.First.X
maxPoint.X = vPoints.Last.X
'sort points based on y values, and get lowest and highest values
vPoints.Sort(Function(x, y) x.Y.CompareTo(y.Y))
minPoint.Y = vPoints.First.Y
maxPoint.Y = vPoints.Last.Y
'sort points based on z values, and get lowest and highest values
vPoints.Sort(Function(x, y) x.Z.CompareTo(y.Z))
minPoint.Z = vPoints.First.Z
maxPoint.Z = vPoints.Last.Z

Dim sizeX As Double = Math.Abs(maxPoint.X - minPoint.X)
Dim sizeY As Double = Math.Abs(maxPoint.Y - minPoint.Y)
Dim sizeZ As Double = Math.Abs(maxPoint.Z - minPoint.Z)

Dim outerDim As String = String.Format("{0} x {1} x {2}", sizeX*10, sizeY*10, sizeZ*10)

iProperties.Value("Project", "Description") = outerDim
MsgBox("Part Dimension:" & outerDim)

The problem is, it does not update my iproperties as shown below.

the value from the msg box for code 1 is already correct, only not updated to the iproperties. is the anywhere to solve these issues?

[JelteDeJong · Accepted solution]

try this:

Public Sub Main()
    ' Get the current Part document.
    Dim doc As PartDocument = ThisDoc.Document

    ' Get the TransientBRep and TransientGeometry objects.
    Dim transBRep As TransientBRep = ThisApplication.TransientBRep

    ' Combine all bodies in Part into a single transient Surface Body.
    Dim combinedBodies As SurfaceBody = Nothing
    For Each surfBody As SurfaceBody In doc.ComponentDefinition.SurfaceBodies
        If combinedBodies Is Nothing Then
            combinedBodies = transBRep.Copy(surfBody)
        Else
            transBRep.DoBoolean(combinedBodies, surfBody, BooleanTypeEnum.kBooleanTypeUnion)
        End If
    Next

    Dim minBox As OrientedBox = combinedBodies.OrientedMinimumRangeBox

    ' Get length of each side of mininum range box.
    Dim dir1 As Double = minBox.DirectionOne.Length
    Dim dir2 As Double = minBox.DirectionTwo.Length
    Dim dir3 As Double = minBox.DirectionThree.Length

    ' Convert lengths to document's length units.
    Dim uom As UnitsOfMeasure = doc.UnitsOfMeasure

    dir1 = uom.ConvertUnits(dir1, UnitsTypeEnum.kDatabaseLengthUnits, uom.LengthUnits)
    dir2 = uom.ConvertUnits(dir2, UnitsTypeEnum.kDatabaseLengthUnits, uom.LengthUnits)
    dir3 = uom.ConvertUnits(dir3, UnitsTypeEnum.kDatabaseLengthUnits, uom.LengthUnits)

    ' Sort lengths from smallest to largest.
    Dim lengths As New List(Of Double) From {dir1, dir2, dir3}
    lengths.Sort()

    SetCustomIproperty(doc, "l", lengths(0))
    SetCustomIproperty(doc, "t", lengths(1))
    SetCustomIproperty(doc, "w", lengths(2))

    'Dim minLength As Integer = lengths(0)
    'Dim midLength As Integer = lengths(1)
    'Dim maxLength As Integer = lengths(2)

    'MessageBox.Show("Oriented Minimum Rangebox Size: " &
    'minLength.ToString("#.###") & " x " & midLength.ToString("#.###") & " x " & maxLength.ToString("#.###"),
    '"Oriented Minimum Rangebox", MessageBoxButtons.OK, MessageBoxIcon.Information)
End Sub

Private Sub SetCustomIproperty(doc As PartDocument, name As String, value As String)
    Dim propSet = doc.PropertySets.Item("Inventor User Defined Properties")
    Try
        Dim prop = propSet.Item(name)
        prop.Value = value
    Catch ex As Exception
        propSet.Add(value, name)
    End Try
End Sub

[syafiqfarhan]

This code looks great and can update my properties. Thanks.

but one new problem happens, the value was not correct

is that possible to make it value without a decimal place? eg l = 40, t = 2225, w = 3106

[JelteDeJong · Accepted solution]

try this:

Public Sub Main()
    ' Get the current Part document.
    Dim doc As PartDocument = ThisDoc.Document

    ' Get the TransientBRep and TransientGeometry objects.
    Dim transBRep As TransientBRep = ThisApplication.TransientBRep

    ' Combine all bodies in Part into a single transient Surface Body.
    Dim combinedBodies As SurfaceBody = Nothing
    For Each surfBody As SurfaceBody In doc.ComponentDefinition.SurfaceBodies
        If combinedBodies Is Nothing Then
            combinedBodies = transBRep.Copy(surfBody)
        Else
            transBRep.DoBoolean(combinedBodies, surfBody, BooleanTypeEnum.kBooleanTypeUnion)
        End If
    Next

    Dim minBox As OrientedBox = combinedBodies.OrientedMinimumRangeBox

    ' Get length of each side of mininum range box.
    Dim dir1 As Double = minBox.DirectionOne.Length
    Dim dir2 As Double = minBox.DirectionTwo.Length
    Dim dir3 As Double = minBox.DirectionThree.Length

    ' Convert lengths to document's length units.
    Dim uom As UnitsOfMeasure = doc.UnitsOfMeasure

    dir1 = uom.ConvertUnits(dir1, UnitsTypeEnum.kDatabaseLengthUnits, uom.LengthUnits)
    dir2 = uom.ConvertUnits(dir2, UnitsTypeEnum.kDatabaseLengthUnits, uom.LengthUnits)
    dir3 = uom.ConvertUnits(dir3, UnitsTypeEnum.kDatabaseLengthUnits, uom.LengthUnits)

    ' Sort lengths from smallest to largest.
    Dim lengths As New List(Of Double) From {dir1, dir2, dir3}
    lengths.Sort()

    Dim numberOfDigits = 1
    SetCustomIproperty(doc, "l", Math.Round(lengths(0), numberOfDigits))
    SetCustomIproperty(doc, "t", Math.Round(lengths(1), numberOfDigits))
    SetCustomIproperty(doc, "w", Math.Round(lengths(2), numberOfDigits))

    'Dim minLength As Integer = lengths(0)
    'Dim midLength As Integer = lengths(1)
    'Dim maxLength As Integer = lengths(2)

    'MessageBox.Show("Oriented Minimum Rangebox Size: " &
    'minLength.ToString("#.###") & " x " & midLength.ToString("#.###") & " x " & maxLength.ToString("#.###"),
    '"Oriented Minimum Rangebox", MessageBoxButtons.OK, MessageBoxIcon.Information)
End Sub

Private Sub SetCustomIproperty(doc As PartDocument, name As String, value As String)
    Dim propSet = doc.PropertySets.Item("Inventor User Defined Properties")
    Try
        Dim prop = propSet.Item(name)
        prop.Value = value
    Catch ex As Exception
        propSet.Add(value, name)
    End Try
End Sub

[stairguy]

This is excellent.  I was wondering if it would be possible to create a usable surface box with the oriented minimum range box, then have dialog that would ask to offset each face of that surface box to create a second surface box.  The second surface box is what we would use to create a machinable blank.