I am looking for a macro that will make crop marks with a white outline. the reason being if my black crop mark are on a black color i can see them. does anybody have code for this or an existing macro?
thanx
Hi bhbp.bg2. i just sent you my code but i not sure if i got the email address right. thanx
Yes,
I recive e-mail...
Here is my crop mark code. I have most of this figured out now. The only thing I don’t know is how to share this with someone else. .....
I reply soon
Greetings!
Hello,I have tested Your code. I think You have to little change to share it. A easiest way to share, i think, is to put all code in form frmCrop. Then open VBEditor, Project View and drag/drop frmCtop module to new project. New project is new CorelDRAW file. This file must be open at first. So You may drag/drop frmCrop to it. When You dragging a plus sign appears near the mouse cursor.You form must have txtSize, txtOffset text boxes, command button RUN CROP MARKS.Code for command button is Your code, with very little changes:
Private Sub CommandButton1_Click()'Me.Hide'RECIVED FROM
''Sub CropMark()''frmCrop.Show vbModeless''End Sub'''''*****************************************************''''Sub MyCrops()
On Error GoTo ErrDim shr As New ShapeRangeDim sGroup As ShapeDim cms As DoubleDim cmo As DoubleDim x As Double, y As Double, w As Double, h As DoubleDim ss As Double, os As DoubleDim s1 As Shape, s2 As Shape, s3 As Shape, s4 As Shape, s5 As Shape, s6 As Shape, s7 As Shape, s8 As ShapeDim s9 As Shape, s10 As Shape, s11 As Shape, s12 As Shape, s13 As Shape, s14 As Shape, s15 As Shape, s16 As Shape
'ss = InputBox("Enter reg mark radius size")ss = 0.25 ' reg mark sizeos = ss * 2 ' reg mark offset from bounding box'cms = 0.3125 ' crop mark size'cms = tbCms.Textcms = txtSize.Value'cmo = 0.0625 ' crop mark offsetcmo = txtOffset.Value
'cms = frmCrop.txtSize'cmo = frmCrop.txtOffset
Set sr = ActiveSelectionRangesr.GetBoundingBox x, y, w, h
If sr.Count = 0 Then GoTo Err
Set s1 = ActiveLayer.CreateLineSegment(x + w, y - cmo, x + w, y - cms - cmo)s1.Outline.SetProperties 0.021, , CreateRGBColor(255, 255, 255)shr.Add s1
Set s2 = ActiveLayer.CreateLineSegment(x + w, y - cmo, x + w, y - cms - cmo)s2.Outline.SetProperties 0.007, , CreateRGBColor(0, 0, 0)shr.Add s2
Set s3 = ActiveLayer.CreateLineSegment(x + w + cmo, y, x + w + cms + cmo, y)s3.Outline.SetProperties 0.021, , CreateRGBColor(255, 255, 255)shr.Add s3
Set s4 = ActiveLayer.CreateLineSegment(x + w + cmo, y, x + w + cms + cmo, y)s4.Outline.SetProperties 0.007, , CreateRGBColor(0, 0, 0)shr.Add s4
Set s5 = ActiveLayer.CreateLineSegment(x - cmo, y, x - cms - cmo, y)s5.Outline.SetProperties 0.021, , CreateRGBColor(255, 255, 255)shr.Add s5
Set s6 = ActiveLayer.CreateLineSegment(x - cmo, y, x - cms - cmo, y)s6.Outline.SetProperties 0.007, , CreateRGBColor(0, 0, 0)shr.Add s6
Set s7 = ActiveLayer.CreateLineSegment(x, y - cmo, x, y - cms - cmo)s7.Outline.SetProperties 0.021, , CreateRGBColor(255, 255, 255)shr.Add s7
Set s8 = ActiveLayer.CreateLineSegment(x, y - cmo, x, y - cms - cmo)s8.Outline.SetProperties 0.007, , CreateRGBColor(0, 0, 0)shr.Add s8
Set s9 = ActiveLayer.CreateLineSegment(x, y + h + cmo, x, y + h + cms + cmo)s9.Outline.SetProperties 0.021, , CreateRGBColor(255, 255, 255)shr.Add s9
Set s10 = ActiveLayer.CreateLineSegment(x, y + h + cmo, x, y + h + cms + cmo)s10.Outline.SetProperties 0.007, , CreateRGBColor(0, 0, 0)shr.Add s10
Set s11 = ActiveLayer.CreateLineSegment(x - cmo, y + h, x - cms - cmo, y + h)s11.Outline.SetProperties 0.021, , CreateRGBColor(255, 255, 255)shr.Add s11
Set s12 = ActiveLayer.CreateLineSegment(x - cmo, y + h, x - cms - cmo, y + h)s12.Outline.SetProperties 0.007, , CreateRGBColor(0, 0, 0)shr.Add s12
Set s13 = ActiveLayer.CreateLineSegment(x + w, y + h + cmo, x + w, y + h + cms + cmo)s13.Outline.SetProperties 0.021, , CreateRGBColor(255, 255, 255)shr.Add s13
Set s14 = ActiveLayer.CreateLineSegment(x + w, y + h + cmo, x + w, y + h + cms + cmo)s14.Outline.SetProperties 0.007, , CreateRGBColor(0, 0, 0)shr.Add s14
Set s15 = ActiveLayer.CreateLineSegment(x + w + cmo, y + h, x + w + cms + cmo, y + h)s15.Outline.SetProperties 0.021, , CreateRGBColor(255, 255, 255)shr.Add s15
Set s16 = ActiveLayer.CreateLineSegment(x + w + cmo, y + h, x + w + cms + cmo, y + h)s16.Outline.SetProperties 0.007, , CreateRGBColor(0, 0, 0)shr.Add s16
Set sGroup = shr.Group
ActiveDocument.ClearSelection
Exit SubErr:MsgBox "No shapes were slected. Please select shape/s and try again.", , "Crop Mark Maker"
End SubGreetings!
a couple of things i dont understand,
that all worked great. The only thing i have left to do is set Property modal of form set to false. can you tell me where to do this.