Macro works for X4 - 2020
You can customize the code to suit your taste. Color, mm,etc.
Sub QuickDimensions()
Dim srSelection As ShapeRange
Dim x As Double, y As Double, w As Double, h As Double
Dim sPt1 As SnapPoint, sPt2 As SnapPoint
Dim s As Shape
Optimization = True
ActiveDocument.BeginCommandGroup "Quick Dimensions"
EventsEnabled = False
ActiveDocument.SaveSettings
ActiveDocument.PreserveSelection = False
On Error GoTo ErrHandler
Set srSelection = ActiveSelectionRange
srSelection.GetBoundingBox x, y, w, h
Set sPt1 = CreateSnapPoint(x, y + h)
Set sPt2 = CreateSnapPoint(x + w, y + h)
Set s = ActiveLayer.CreateLinearDimension(cdrDimensionHorizontal, sPt1, sPt2, True, , , cdrDimensionStyleFractional, Units:=cdrDimensionUnitIN)
s.Dimension.TextShape.SetPosition x + w / 2, y + h + 1
s.Dimension.TextShape.Text.Story.Size = 54
s.Dimension.TextShape.Fill.UniformColor.CMYKAssign 45, 45, 45, 100
Set sPt1 = CreateSnapPoint(x, y)
Set sPt2 = CreateSnapPoint(x, y + h)
Set s = ActiveLayer.CreateLinearDimension(cdrDimensionVertical, sPt1, sPt2, True, , , cdrDimensionStyleFractional, Units:=cdrDimensionUnitIN)
s.Dimension.TextShape.SetPosition x - 1, y + sx / 2
s.Dimension.TextShape.Text.Story.Size = 54
s.Dimension.TextShape.Fill.UniformColor.CMYKAssign 45, 45, 45, 100
ExitSub:
ActiveDocument.PreserveSelection = True
ActiveDocument.RestoreSettings
EventsEnabled = True
Optimization = False
ActiveDocument.ClearSelection
ActiveWindow.Refresh
Application.Refresh
ActiveDocument.EndCommandGroup
Exit Sub
ErrHandler:
MsgBox "Error occured: " & Err.Description
Resume ExitSub
End Sub