Sub CropMarkMM()

    '------------------------------------------------------------------
    
    Const Offset As Double = 1 'mm - Cropmark offset
    Const Length As Double = 5 'mm - Cropmark length
    Const Grow As Double = 0 'mm - Grow/contract cropmarks' base box
    
    'Outline color
    'RGB: RGB255,USER,r,g,b where r,g,b = 0-255
    'CMYK: CMYK,USER,c,m,y,b where c,m,y,b = 0-100
    'Registration: REGCOLOR,USER,tint where tint = 0-100
    Const OutlineColor As String = "REGCOLOR,USER,100"
    
    '------------------------------------------------------------------
    
    ActiveDocument.Unit = cdrMillimeter
    
    Dim Box As Rect
    Set Box = ActiveSelectionRange.BoundingBox.GetCopy
    Dim Marks As ShapeRange
    Set Marks = CreateShapeRange
    
    With Box
        .Inflate Grow, Grow, Grow, Grow
        Marks.AddRange PlaceMarksCorner(.Left, .Top, Offset, Length, 0)
        Marks.AddRange PlaceMarksCorner(.Right, .Top, Offset, Length, -90)
        Marks.AddRange PlaceMarksCorner(.Right, .Bottom, Offset, Length, -180)
        Marks.AddRange PlaceMarksCorner(.Left, .Bottom, Offset, Length, -270)
    End With
    
    Marks.Group.Outline.Color.CopyAssign CreateColor(OutlineColor)
 
End Sub

Private Function PlaceMarksCorner( _
                     ByVal PivotX As Double, _
                     ByVal PivotY As Double, _
                     ByVal Offset As Double, _
                     ByVal Length As Double, _
                     ByVal Angle As Double _
                 ) As ShapeRange
    Set PlaceMarksCorner = CreateShapeRange
    With PlaceMarksCorner
        .Add ActiveLayer.CreateLineSegment( _
            PivotX - Offset, PivotY, _
            PivotX - Offset - Length, PivotY _
        )
        .Add ActiveLayer.CreateLineSegment( _
            PivotX, PivotY + Offset, _
            PivotX, PivotY + Offset + Length _
        )
        .RotateEx Angle, PivotX, PivotY
    End With
End Function