Dimension with UCS

[Sekar]

Hi.,

 

Attached herewith the reference screenshot and code for the same.

 

my dimension 1600 is placed at the bottom, eventhough the ucs is at the top. How to rectify it. Please suggest.

Sub AddTableTop(ByVal length As Integer, ByVal width As Integer, ByVal height As Integer, ByRef submissionArray() As Variant)
    ' Declare variables
    Dim acadApp As Object
    Dim acadDoc As Object
    Dim acadModelSpace As Object
    Dim centerPoint(0 To 2) As Double
    Dim cornerPoint(0 To 2) As Double
    'Dim length As Integer
    'Dim width As Integer
    'Dim height As Integer
    Dim adPoint As AcadPoint
    Dim ptPlace(0 To 2) As Double
    Dim solid As Object
     Dim totalAdjustment As Double
     Dim i As Integer
     Dim dimObj As AcadDimAligned
    Dim location(0 To 2) As Double
    Dim ucsMatrix As Variant
    Dim ucs As AcadUCS
    Dim originPoint(0 To 2) As Double
    Dim xAxisPoint(0 To 2) As Double
    Dim yAxisPoint(0 To 2) As Double
    Dim solidPoint(0 To 2) As Double
    ' Get the AutoCAD application
    Set acadApp = GetObject(, "AutoCAD.Application")
    Set acadDoc = acadApp.ActiveDocument
    Set acadModelSpace = acadDoc.ModelSpace
    
    length = CInt(UserForm1.TextBox2.Text)
    width = CInt(UserForm1.TextBox3.Text)
    height = CInt(UserForm1.TextBox4.Text)
    
    Dim varPoint As Variant
    MsgBox "Pick the reference point:"
    varPoint = ThisDrawing.Utility.GetPoint(, "Get the placement point")
    
    ptPlace(0) = varPoint(0)
    ptPlace(1) = varPoint(1)
    ptPlace(2) = varPoint(2)
    
    ' Define the center point (bottom-left center of the box)
    centerPoint(0) = 0     ' X coordinate
    centerPoint(1) = 0       ' Y coordinate
    centerPoint(2) = 0       ' Z coordinate
    
    
    ' Define the dimensions of the box
    'length = 2450  ' Length of the box along the X-axis
    'width = 750    ' Width of the box along the Y-axis
    'height = 20   ' Height of the box along the Z-axis
    
    
    Set adPoint = ThisDrawing.ModelSpace.AddPoint(ptPlace)
    
    ' Add the 3D solid box to the ModelSpace
    Set solid = acadModelSpace.AddBox(centerPoint, length, width, height)
    
    cornerPoint(0) = (centerPoint(0) - length / 2)
    cornerPoint(1) = (centerPoint(1) - width / 2)
    cornerPoint(2) = centerPoint(2) - height / 2
    
    ' Calculate the total adjustment for ptPlace(0) dynamically
    totalAdjustment = 0
    For i = LBound(submissionArray, 2) To UBound(submissionArray, 2)
        totalAdjustment = totalAdjustment + submissionArray(1, i)
    Next i
    
    ' Dynamically adjust ptPlace(0) based on submissionArray values
    solidPoint(0) = ptPlace(0) - ((length - totalAdjustment) / 2)
    
    
    
    'ptPlace(0) = ptPlace(0) - ((length - submissionArray(1, 1) - submissionArray(1, 2) - submissionArray(1, 3)) / 2)
    solidPoint(1) = ptPlace(1) - 25
    solidPoint(2) = ptPlace(2)
    ' Move the 3D solid using the displacement vector
    solid.Move cornerPoint, solidPoint
    
    Dim EndPoint(0 To 2) As Double
    
    ' Define the endpoint of the dimension line
    EndPoint(0) = ptPlace(0) + length
    EndPoint(1) = ptPlace(1)
    EndPoint(2) = ptPlace(2)
    
 
    
    ' Define the location of the dimension text
    location(0) = ptPlace(0)
    location(1) = ptPlace(1) + 1500
    location(2) = ptPlace(2)
    
        
    
    ' Define the UCS origin (e.g., at Z = 750)
    originPoint(0) = ptPlace(0)  ' X coordinate
    originPoint(1) = ptPlace(1)  ' Y coordinate
    originPoint(2) = ptPlace(2)  ' Z coordinate

    ' Define a point on the X-axis relative to the origin
    xAxisPoint(0) = ptPlace(0) + 1  ' X coordinate (1 unit in the X direction)
    xAxisPoint(1) = ptPlace(1)  ' Y coordinate
    xAxisPoint(2) = ptPlace(2)  ' Z coordinate (same Z as origin)

    ' Define a point on the Y-axis relative to the origin
    yAxisPoint(0) = ptPlace(0) ' X coordinate
    yAxisPoint(1) = ptPlace(1) + 1 ' Y coordinate (1 unit in the Y direction)
    yAxisPoint(2) = ptPlace(2)  ' Z coordinate (same Z as origin)
    
    
     'Create UCS with Z-elevation at 750
    Set ucs = acadDoc.UserCoordinateSystems.Add(originPoint, xAxisPoint, yAxisPoint, "TempUCS")
    acadDoc.ActiveUCS = ucs
    'acadDoc.SendCommand "_.ucs _z 750 " & vbCr
    
    Debug.Print ptPlace(0)
    Debug.Print ptPlace(1)
    Debug.Print ptPlace(2)
    Set dimObj = ThisDrawing.ModelSpace.AddDimAligned(ptPlace, EndPoint, location)
        
        'acadDoc.ActiveUCS = acadDoc.UserCoordinateSystems.Item("WCS")
        
    ' Zoom to fit the box in the view
    acadApp.ZoomAll

End Sub