Registration Mark Macro

You can try following code

Sub cropMarks_Vertical()
    Dim sr As ShapeRange, sCirc As Shape, sline1 As Shape, sLine2 As Shape, sr2 As New ShapeRange, s As Shape
    Dim x#, y#, w#, h#
    Dim dCropRadius#
    dCropRadius = 0.15
    Set sr = ActiveSelectionRange
    If sr.Count = 0 Then Exit Sub
    ActiveDocument.BeginCommandGroup "CropMarkCustom"
    sr.GetBoundingBox x, y, w, h
    Set sCirc = ActiveLayer.CreateEllipse2(0, 0, dCropRadius, 0, 90, 180, True)
    sCirc.Fill.UniformColor.RegistrationAssign
    sCirc.Outline.Type = cdrNoOutline
    sr2.Add sCirc
    Set sCirc = ActiveLayer.CreateEllipse2(0, 0, dCropRadius, 0, 270, 0, True)
    sCirc.Fill.UniformColor.RegistrationAssign
    sCirc.Outline.Type = cdrNoOutline
    sr2.Add sCirc
    Set sCirc = ActiveLayer.CreateEllipse2(0, 0, dCropRadius)
    sCirc.Fill.ApplyNoFill
    sCirc.Outline.Color.RegistrationAssign
    sr2.Add sCirc
    Set sline1 = ActiveLayer.CreateLineSegment(0, 0, dCropRadius * 3.33, 0)
    Set sLine2 = ActiveLayer.CreateLineSegment(0, 0, 0, dCropRadius * 3.33)
    sline1.AlignToShape cdrAlignHCenter, sCirc: sline1.AlignToShape cdrAlignVCenter, sCirc: sr2.Add sline1
    sLine2.AlignToShape cdrAlignHCenter, sCirc: sLine2.AlignToShape cdrAlignVCenter, sCirc: sr2.Add sLine2
    Set s = sr2.Group
    Set sr2 = New ShapeRange: sr2.Add s
    s.AlignToShapeRange cdrAlignHCenter, sr
    ActiveDocument.ReferencePoint = cdrCenter
    s.SetPositionEx cdrCenter, s.PositionX, y - 0.625  '(.5 + .125 )
    Set s = s.Duplicate(0, h + 1.25)
    sr2.Add s
    Set s = sr2.Group
    With s
        .Outline.Width = 0.01  'set width here in inches
        .Outline.Color.RegistrationAssign
        .CreateSelection
        .Name = "VERTICAL Crop Marks"
    End With
    ActiveDocument.EndCommandGroup
End Sub
 

Best regards

Mek