I created a SIMPLE macro that worked great in for X4. I can't get it to work in X7. I'm not going to give the code as it uses a "less than desired" method. basically cuts and pastes the selected item, imports a dimensions.cdr file that is nothing more than four corner marks with dimensions added to them. It then takes the upper right corner and aligns to the upper right of the selected and does the same for all the corners then deletes those corners leaving the dimension lines, then some more confusing stuff
I assigned my macro a hot key whereby I can select a shape/object/image etc. and hit the letter d and it would instantly drop in the dimensions for that object. I could select any other object and hit the letter d and get dimensions placed on that object. It retained them as dimensions but not locked to the object. So you could select them as a whole, move them around and/or and scale them up or down and the dimensions would change accordingly. That's exactly how I want it to work! SIMPLE. I don't have to choose any other options or hit any other keys etc.
It will only let you do it once in X7. If you try to dimension another shape it creates the dimensions but they're locked to the shape and other duplicated shapes are inserted.
Corel should have this feature already. You should be able to select any one item and hit a button to get what is seen below.
Anyone have any suggestions? It's macro our company would be willing to pay for if it worked exactly how we want.
Myron,
You should be able to do something like this:
Sub QuickDimensions() Dim srSelection As ShapeRange Dim x As Double, y As Double, w As Double, h As Double Dim sPt1 As SnapPoint, sPt2 As SnapPoint Dim s As Shape Optimization = True ActiveDocument.BeginCommandGroup "Quick Dimensions" EventsEnabled = False ActiveDocument.SaveSettings ActiveDocument.PreserveSelection = False On Error GoTo ErrHandler Set srSelection = ActiveSelectionRange srSelection.GetBoundingBox x, y, w, h Set sPt1 = CreateSnapPoint(x, y + h) Set sPt2 = CreateSnapPoint(x + w, y + h) Set s = ActiveLayer.CreateLinearDimension(cdrDimensionHorizontal, sPt1, sPt2, True, , , cdrDimensionStyleFractional, Units:=cdrDimensionUnitIN) s.Dimension.TextShape.SetPosition x + w / 2, y + h + 0.5 s.Dimension.TextShape.Text.Story.Size = 24 Set sPt1 = CreateSnapPoint(x, y) Set sPt2 = CreateSnapPoint(x, y + h) Set s = ActiveLayer.CreateLinearDimension(cdrDimensionVertical, sPt1, sPt2, True, , , cdrDimensionStyleFractional, Units:=cdrDimensionUnitIN) s.Dimension.TextShape.SetPosition x - 0.5, y + sx / 2 s.Dimension.TextShape.Text.Story.Size = 24 ExitSub: ActiveDocument.PreserveSelection = True ActiveDocument.RestoreSettings EventsEnabled = True Optimization = False ActiveDocument.ClearSelection ActiveWindow.Refresh Application.Refresh ActiveDocument.EndCommandGroup Exit Sub ErrHandler: MsgBox "Error occured: " & Err.Description Resume ExitSub End Sub
If you want your Dimension Style to be in Fraction you will need to change the Default Style for the document as it looks like there is a bug in X7 that doesn't let you set this via code. There maybe a way to do this via a StyleSet but I have not had the time to dig into it.
Hopefully this is close enough, if not let me know.
-Shelby