Just for fun I create some TextGraphics displayed at all the of the corners of the box (middle justified). My part and assembly are both in centimeters so there no conversion (rounding) issues. Also, the parts only sketch is constrained to 0,0 and the part is constrained to the origin workplanes in the assembly so the coordinate system of both the part file and the part wthin the assembly, are the same. Why isn't the TextGraphics.Text show 0 for those that lies along the X, Y & Z axis? See the attached graphic
{code}
Dim oTransientGeometry As TransientGeometry
Dim oPoint As Point
'Draws a bounding box of a part (occurrence) in the context of the assembly.
Public Sub DrawOccurrenceRangeBox()
Dim oAssemblyDocument As AssemblyDocument
Dim oComponentOccurrence As ComponentOccurrence
Dim oGraphicsDataSets As GraphicsDataSets
Dim oClientGraphics As ClientGraphics
Dim oSurfaceBody As SurfaceBody
Dim oBox As Box
Dim oGraphicsNode As GraphicsNode
Dim oLineGraphics As LineGraphics
Dim oGraphicsCoordinateSet As GraphicsCoordinateSet
Dim adBoxLines(1 To 12 * 6) As Double
Dim adMinPoint(1 To 3) As Double
Dim adMaxPoint(1 To 3) As Double
Dim oTextGraphics_Pnt1 As TextGraphics
Dim oTextGraphics_Pnt2 As TextGraphics
Dim oTextGraphics_Pnt3 As TextGraphics
Dim oTextGraphics_Pnt4 As TextGraphics
Dim oTextGraphics_Pnt5 As TextGraphics
Dim oTextGraphics_Pnt6 As TextGraphics
Dim oTextGraphics_Pnt7 As TextGraphics
Dim oTextGraphics_Pnt8 As TextGraphics
Dim oTextGraphics_xLen As TextGraphics
Dim oTextGraphics_yLen As TextGraphics
Dim oTextGraphics_zLen As TextGraphics
'create Transient Geometry for text anchor point
Set oTransientGeometry = ThisApplication.TransientGeometry
' Set a reference to the active assembly.
Set oAssemblyDocument = ThisApplication.ActiveDocument
' Make sure an occurrence is selected.
On Error Resume Next
Set oComponentOccurrence = oAssemblyDocument.SelectSet.Item(1)
If Err.Number <> 0 Then
MsgBox "You must select an occurrence to display the range box."
' Delete any graphics, if they exist.
On Error Resume Next
Set oGraphicsDataSets = oAssemblyDocument.GraphicsDataSetsCollection.Item("RangeBoxGraphics")
If Err.Number = 0 Then
On Error GoTo 0
Set oClientGraphics = oAssemblyDocument.ComponentDefinition. _
ClientGraphicsCollection.Item("RangeBoxGraphics")
oClientGraphics.Delete
oGraphicsDataSets.Delete
ThisApplication.ActiveView.Update
End If
Exit Sub
Else
' Check to make sure it 's a leaf level component.
If oComponentOccurrence.DefinitionDocumentType <> kPartDocumentObject Then
MsgBox "A leaf component (Part) must be selected."
Exit Sub
End If
End If
' Create a transient body of the selected part. Transform the body =to
' match the transform in the assembly.
Set oSurfaceBody = ThisApplication.TransientBRep.Copy(oComponentOccurrence.Definition.SurfaceBodies.Item(1))
Call ThisApplication.TransientBRep.Transform(oSurfaceBody, oComponentOccurrence.Transformation)
' Get the range box of the transformed body.
Set oBox = oSurfaceBody.RangeBox
' Check to see if range box graphics information already exists.
On Error Resume Next
Set oGraphicsDataSets = oAssemblyDocument.GraphicsDataSetsCollection.Item("RangeBoxGraphics")
If Err Then
Err.Clear
On Error GoTo 0
' Set a reference to the transient geometry object for user =later.
Set oTransientGeometry = ThisApplication.TransientGeometry
' Create a graphics data set object. This object contains all of =the
' information used to define the graphics.
Set oGraphicsDataSets = oAssemblyDocument.GraphicsDataSetsCollection.Add("RangeBoxGraphics")
' Create a coordinate set.
Set oGraphicsCoordinateSet = oGraphicsDataSets.CreateCoordinateSet(1)
' Create the client graphics for this compdef.
Set oClientGraphics = oAssemblyDocument.ComponentDefinition.ClientGraphicsCollection.Add( _
"RangeBoxGraphics")
' Create a graphics node.
Set oGraphicsNode = oClientGraphics.AddNode(1)
oGraphicsNode.Selectable = False
' Create line graphics.
Set oLineGraphics = oGraphicsNode.AddLineGraphics
oLineGraphics.CoordinateSet = oGraphicsCoordinateSet
'add Text Graphics to node
Set oTextGraphics_Pnt1 = oGraphicsNode.AddScalableTextGraphics
Set oTextGraphics_Pnt2 = oGraphicsNode.AddScalableTextGraphics
Set oTextGraphics_Pnt3 = oGraphicsNode.AddScalableTextGraphics
Set oTextGraphics_Pnt4 = oGraphicsNode.AddScalableTextGraphics
Set oTextGraphics_Pnt5 = oGraphicsNode.AddScalableTextGraphics
Set oTextGraphics_Pnt6 = oGraphicsNode.AddScalableTextGraphics
Set oTextGraphics_Pnt7 = oGraphicsNode.AddScalableTextGraphics
Set oTextGraphics_Pnt8 = oGraphicsNode.AddScalableTextGraphics
Set oTextGraphics_xLen = oGraphicsNode.AddScalableTextGraphics
Set oTextGraphics_yLen = oGraphicsNode.AddScalableTextGraphics
Set oTextGraphics_zLen = oGraphicsNode.AddScalableTextGraphics
Else
Set oGraphicsCoordinateSet = oGraphicsDataSets.ItemById(1)
Set oGraphicsNode = oAssemblyDocument.ComponentDefinition.ClientGraphicsCollection.Item( _
"RangeBoxGraphics").ItemById(1)
Set oTextGraphics_Pnt1 = oGraphicsNode.Item(2)
Set oTextGraphics_Pnt2 = oGraphicsNode.Item(3)
Set oTextGraphics_Pnt3 = oGraphicsNode.Item(4)
Set oTextGraphics_Pnt4 = oGraphicsNode.Item(5)
Set oTextGraphics_Pnt5 = oGraphicsNode.Item(6)
Set oTextGraphics_Pnt6 = oGraphicsNode.Item(7)
Set oTextGraphics_Pnt7 = oGraphicsNode.Item(8)
Set oTextGraphics_Pnt8 = oGraphicsNode.Item(9)
Set oTextGraphics_xLen = oGraphicsNode.Item(10)
Set oTextGraphics_yLen = oGraphicsNode.Item(11)
Set oTextGraphics_zLen = oGraphicsNode.Item(12)
End If
Call oBox.GetBoxData(adMinPoint, adMaxPoint)
' Line 1 -------------------------------------------------------------------
adBoxLines(1) = adMinPoint(1)
adBoxLines(2) = adMinPoint(2)
adBoxLines(3) = adMinPoint(3)
adBoxLines(4) = adMaxPoint(1)
adBoxLines(5) = adMinPoint(2)
adBoxLines(6) = adMinPoint(3)
'Debug.Print "Line 1: " & C(adMinPoint(1)) & "," & C(adMinPoint(2)) & "," & C(adMinPoint(3)) & " : " & C(adMaxPoint(1)) & "," & C(adMinPoint(2)) & "," & C(adMinPoint(3))
'Point 1
DrawingCoord_Pnt oTextGraphics_Pnt1, "1", adMinPoint(1), adMinPoint(2), adMinPoint(3)
'Point 2
DrawingCoord_Pnt oTextGraphics_Pnt2, "2", adMaxPoint(1), adMinPoint(2), adMinPoint(3)
' Line 2 ---------------------------------------------------------------------
adBoxLines(7) = adMinPoint(1)
adBoxLines(8) = adMinPoint(2)
adBoxLines(9) = adMinPoint(3)
adBoxLines(10) = adMinPoint(1)
adBoxLines(11) = adMaxPoint(2)
adBoxLines(12) = adMinPoint(3)
'Debug.Print "Line 2: " & C(adMaxPoint(1)) & "," & C(adMinPoint(2)) & "," & C(adMinPoint(3)) & " : " & C(adMinPoint(1)) & "," & C(adMaxPoint(2)) & "," & C(adMinPoint(3))
'Point 3
DrawingCoord_Pnt oTextGraphics_Pnt3, "3", adMinPoint(1), adMaxPoint(2), adMinPoint(3)
' Line 3 --------------------------------------------------------------------
adBoxLines(13) = adMinPoint(1)
adBoxLines(14) = adMinPoint(2)
adBoxLines(15) = adMinPoint(3)
adBoxLines(16) = adMinPoint(1)
adBoxLines(17) = adMinPoint(2)
adBoxLines(18) = adMaxPoint(3)
'Debug.Print "Line 3: " & C(adMinPoint(1)) & "," & C(adMinPoint(2)) & "," & C(adMinPoint(3)) & " : " & C(adMinPoint(1)) & "," & C(adMinPoint(2)) & "," & C(adMaxPoint(3))
'Point 4
DrawingCoord_Pnt oTextGraphics_Pnt4, "4", adMinPoint(1), adMinPoint(2), adMaxPoint(3)
' Line 4
adBoxLines(19) = adMaxPoint(1)
adBoxLines(20) = adMaxPoint(2)
adBoxLines(21) = adMaxPoint(3)
adBoxLines(22) = adMinPoint(1)
adBoxLines(23) = adMaxPoint(2)
adBoxLines(24) = adMaxPoint(3)
'Debug.Print "Line 4: " & C(adMaxPoint(1)) & "," & C(adMaxPoint(2)) & "," & C(adMaxPoint(3)) & " : " & C(adMinPoint(1)) & "," & C(adMaxPoint(2)) & "," & C(adMaxPoint(3))
'Point 5
DrawingCoord_Pnt oTextGraphics_Pnt5, "5", adMaxPoint(1), adMaxPoint(2), adMaxPoint(3)
'Point 6
DrawingCoord_Pnt oTextGraphics_Pnt6, "6", adMinPoint(1), adMaxPoint(2), adMaxPoint(3)
' Line 5
adBoxLines(25) = adMaxPoint(1)
adBoxLines(26) = adMaxPoint(2)
adBoxLines(27) = adMaxPoint(3)
adBoxLines(28) = adMaxPoint(1)
adBoxLines(29) = adMinPoint(2)
adBoxLines(30) = adMaxPoint(3)
'Debug.Print "Line 5: " & C(adMaxPoint(1)) & "," & C(adMaxPoint(2)) & "," & C(adMaxPoint(3)) & " : " & C(adMaxPoint(1)) & "," & C(adMinPoint(2)) & "," & C(adMaxPoint(3))
'Point 7
DrawingCoord_Pnt oTextGraphics_Pnt7, "7", adMaxPoint(1), adMinPoint(2), adMaxPoint(3)
' Line 6
adBoxLines(31) = adMaxPoint(1)
adBoxLines(32) = adMaxPoint(2)
adBoxLines(33) = adMaxPoint(3)
adBoxLines(34) = adMaxPoint(1)
adBoxLines(35) = adMaxPoint(2)
adBoxLines(36) = adMinPoint(3)
'Debug.Print "Line 6: " & C(adMaxPoint(1)) & "," & C(adMaxPoint(2)) & "," & C(adMaxPoint(3)) & " : " & C(adMaxPoint(1)) & "," & C(adMaxPoint(2)) & "," & C(adMinPoint(3))
'Point 8
DrawingCoord_Pnt oTextGraphics_Pnt8, "8", adMaxPoint(1), adMaxPoint(2), adMinPoint(3)
' Line 7
adBoxLines(37) = adMinPoint(1)
adBoxLines(38) = adMaxPoint(2)
adBoxLines(39) = adMinPoint(3)
adBoxLines(40) = adMaxPoint(1)
adBoxLines(41) = adMaxPoint(2)
adBoxLines(42) = adMinPoint(3)
'Debug.Print "Line 7: " & C(adMinPoint(1)) & "," & C(adMaxPoint(2)) & "," & C(adMinPoint(3)) & " : " & C(adMaxPoint(1)) & "," & C(adMaxPoint(2)) & "," & C(adMinPoint(3))
' Line 8
adBoxLines(43) = adMinPoint(1)
adBoxLines(44) = adMaxPoint(2)
adBoxLines(45) = adMinPoint(3)
adBoxLines(46) = adMinPoint(1)
adBoxLines(47) = adMaxPoint(2)
adBoxLines(48) = adMaxPoint(3)
'Debug.Print "Line 8: " & C(adMinPoint(1)) & "," & C(adMaxPoint(2)) & "," & C(adMinPoint(3)) & " : " & C(adMinPoint(1)) & "," & C(adMaxPoint(2)) & "," & C(adMaxPoint(3))
' Line 9
adBoxLines(49) = adMaxPoint(1)
adBoxLines(50) = adMinPoint(2)
adBoxLines(51) = adMaxPoint(3)
adBoxLines(52) = adMaxPoint(1)
adBoxLines(53) = adMinPoint(2)
adBoxLines(54) = adMinPoint(3)
'Debug.Print "Line 9: " & C(adMaxPoint(1)) & "," & C(adMinPoint(2)) & "," & C(adMaxPoint(3)) & " : " & C(adMaxPoint(1)) & "," & C(adMinPoint(2)) & "," & C(adMinPoint(3))
' Line 10
adBoxLines(55) = adMaxPoint(1)
adBoxLines(56) = adMinPoint(2)
adBoxLines(57) = adMaxPoint(3)
adBoxLines(58) = adMinPoint(1)
adBoxLines(59) = adMinPoint(2)
adBoxLines(60) = adMaxPoint(3)
'Debug.Print "Line 10: " & C(adMaxPoint(1)) & "," & C(adMinPoint(2)) & "," & C(adMaxPoint(3)) & " : " & C(adMinPoint(1)) & "," & C(adMinPoint(2)) & "," & C(adMaxPoint(3))
' Line 11
adBoxLines(61) = adMinPoint(1)
adBoxLines(62) = adMinPoint(2)
adBoxLines(63) = adMaxPoint(3)
adBoxLines(64) = adMinPoint(1)
adBoxLines(65) = adMaxPoint(2)
adBoxLines(66) = adMaxPoint(3)
'Debug.Print "Line 11: " & C(adMinPoint(1)) & "," & C(adMinPoint(2)) & "," & C(adMaxPoint(3)) & " : " & C(adMinPoint(1)) & "," & C(adMaxPoint(2)) & "," & C(adMaxPoint(3))
' Line 12
adBoxLines(67) = adMaxPoint(1)
adBoxLines(68) = adMinPoint(2)
adBoxLines(69) = adMinPoint(3)
adBoxLines(70) = adMaxPoint(1)
adBoxLines(71) = adMaxPoint(2)
adBoxLines(72) = adMinPoint(3)
'Debug.Print "Line 12: " & C(adMaxPoint(1)) & "," & C(adMinPoint(2)) & "," & C(adMinPoint(3)) & " : " & C(adMaxPoint(1)) & "," & C(adMaxPoint(2)) & "," & C(adMinPoint(3))
' Assign the points into the coordinate set.
Call oGraphicsCoordinateSet.PutCoordinates(adBoxLines)
' Update the display.
ThisApplication.ActiveView.Update
End Sub
Sub DrawingCoord_Pnt(oTextGraphics As TextGraphics, sPointNum As String, ByVal X As Double, ByVal Y As Double, ByVal Z As Double)
Debug.Print "P " & sPointNum & ": " & X & "," & Y & "," & X
oTextGraphics.Text = "P" & sPointNum & ": " & C(X) & "," & C(Y) & "," & C(Z)
oTextGraphics.SetTransformBehavior oTransientGeometry.CreatePoint(X, Y, Z), kFrontFacingAndPixelScaling
oTextGraphics.FontSize = 10
oTextGraphics.HorizontalAlignment = kAlignTextCenter
oTextGraphics.VerticalAlignment = kAlignTextMiddle
End Sub
Function C(dCoord As Double) As String
C = CStr(dCoord)
' Dim iP As Integer
' iP = InStr(C, ".")
' If iP <> 0 Then C = Mid(C, 1, iP + 3)
End Function
{code}