Hi,
We have certain registration marks that we use on our designs before we print to vellum.
Would someone here be able to write a macro that could do the following? I've attached an example image of where we place the registration marks and am also attaching the actual registration mark CDR file. I'm assuming this would probably be rather simple...
We'd like this registration mark to be centered to the image and placed on the top and bottom of the image at .25 inches away from the image itself. So, I would think the macro would have to select the entire image on the page, then decide where .25 inches is away from the top and bottom of the image and place the registration mark, centered in that area.
Does that make sense? LOL Hopefully my sample image will show where we would like them.
Thanks anyone who can help!!! =)
Jason
Hi.
What about this macro.
http://www.oberonplace.com/vba/drawmacros/cropmarksh.htm
~John
I've tried that macro and it doesn't really do what we need it to. It adds extra cut marks to four corners, adds registration marks to four sides of the image.
Being the lazy person I am, I was hoping for one that could simply place the two registration marks we use centered the the image on both the top and the bottom of the graphic. I haven't been able to find one that can do it the way we would hope for, so I thought I'd ask here =)
Also, it would be awesome if I could just hit a key, like F6 and have it all happen automatically lol
I know I know....awfully picky of me =)
Ok.
Try this then:
Sub cropMarks1() 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.25 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 * 2, 0) Set sLine2 = ActiveLayer.CreateLineSegment(0, 0, 0, dCropRadius * 2) 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.25 Set s = s.Duplicate(0, h + (dCropRadius * 2)) sr2.Add s sr2.CreateSelection ActiveDocument.EndCommandGroupEnd Sub
Hi John!
I'm replying from home, so thats why it's coming from a different account than my initial post =)
I've attached a screenshot of how the macro worked on my graphic. As you can see, it placed the registration marks actually touching the graphic and for some reason not .25 inches away from the graphic. Also, would it be possible to actually use the registration mark I attached in the initial post?
We also need to be sure that the registration mark is using the 'registration color' so that it would print on all plates when we do color seps from CorelDraw.
Thanks for your help!!!
The center of the registration mark is .25 inches away, you can also change size of mak in macro (dCropRadius = 0.25)
You can also make crosshair lines extend by changing both occurances of:
dCropRadius * 2
in the CreateLineSegment parameter to
dCropRadius * 3
Changing outline color is easy. What color do you need it to be?
Thanks for the info on how to change that. Is there a way to adjust the thickness of the outline itself?
I've attached a screenshot of where to find the registration color in CorelDraw. This is the name of the color and it allows the registration mark to be printed on each of the color seps pages. If you download the file I attached in my original post, you can see it in there also.
Thanks John!!
Try this:
Sub cropMarks1() 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.25 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, 0) Set sLine2 = ActiveLayer.CreateLineSegment(0, 0, 0, dCropRadius * 3) 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.25 Set s = s.Duplicate(0, h + (dCropRadius * 2)) sr2.Add s Set s = sr2.Group With s .Outline.Width = 0.05 'set width here .Outline.Color.RegistrationAssign .CreateSelection .Name = "Custom Crop Marks" End With ActiveDocument.EndCommandGroupEnd Sub
John I made a few changes, just in sizes, to give them what I think they want. Steve E.
Sub cropMarks1() 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.125 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 * 4, 0) Set sLine2 = ActiveLayer.CreateLineSegment(0, 0, 0, dCropRadius * 4) 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 Set s = s.Duplicate(0, h + (0.625 * 2)) sr2.Add s Set s = sr2.Group With s .Outline.Width = 0.015 'set width here in inches .Outline.Color.RegistrationAssign .CreateSelection .Name = "Custom Crop Marks" End With ActiveDocument.EndCommandGroupEnd Sub
That's it! Works perfect! Thanks you guys for doing this =)
Now, could we do the very same macro, but instead of centered vertically, center them horizontally on the left and right sides?
Sometimes we need to place them in this manner as well.
So, we would have two macros...the one above for vertical centered registration marks and then a second for horizontally placed marks =)