I currently have this macro set up
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): 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
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
which gives me this result
I would like this
Is this possible with my current macro? The marks are vertical and are placed .375"away from the art. Any help would be greatly appreciated. Thanks
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.EndCommandGroupEnd Sub
Best regards
Mek