Constant area macro or VB?

I use CorelDraw 12 at work to design signs. Very often the area of a sign must conform to local zoning codes which restrict sign dimensions to a given area in square feet. The ability to specify the area of an object and have that remain constant while I stretch or squeeze it would be extremely useful. Is there a way to accomplish this in Corel by using some undocumented key combinations a macro or Visual Basic program? Is this a feature of version X3?

Chester

[shelbym]

As far as I know there is no feature to do this. But I think you could get pretty close with VBA. I have not had a lot of time to polish this, but it basically does what you want. Define a shape a FixedAreaShape by running MakeMeFixedArea() while the shape it selected. From then on it will resize itself to get back to the original area. (Area is pretty crude, just w * h, so really it only works well on rectangles.) If you don't want the shape to keep the area any longer run the RemoveFixedArea(). I have only tested this in X3 and have run into a couple times it doesn't want to resize correctly....could be rounding or something.....but I don't have the time right now to dig into it.

Just wanted to prove YES with a little polish you could do this.

'---------This need to go in Global Macro Storage---------------
Dim WithEvents CurDoc As Document

Private Sub CurDoc_ShapeTransform(ByVal Shape As Shape)
    area.FixedArea Shape
End Sub

Private Sub GlobalMacroStorage_WindowActivate(ByVal Doc As Document, ByVal Window As Window)
    Set CurDoc = Doc
    MsgBox "Active"
End Sub
'--------------------------------------------------------------

'-----------This need to go a Module named: area---------------
Sub MakeMeFixedArea()

Dim s As Shape
Dim w As Double, h As Double
Dim area As Double

Set s = Application.ActiveShape

CheckDataItem ("SizeW")
CheckDataItem ("SizeH")
CheckDataItem ("Area")

s.GetSize w, h
s.Name = "FixedArea"
s.ObjectData("SizeW").Value = Round(w, 3)
s.ObjectData("SizeH").Value = Round(h, 3)
s.ObjectData("Area").Value = Round(Round(w, 3) * Round(h, 3), 3)

End Sub

Sub RemoveFixedArea()

Dim s As Shape

Set s = Application.ActiveShape

s.Name = ""
s.ObjectData("SizeW").Value = ""
s.ObjectData("SizeH").Value = ""
s.ObjectData("Area").Value = ""

End Sub

Sub FixedArea(s As Shape)

Dim w As Double, h As Double
Dim area As Double

If s.Name = "FixedArea" Then

area = s.ObjectData("Area")

    If CDbl(s.ObjectData("SizeH")) <> Round(s.SizeHeight, 3) Then
        MsgBox "Stored H: " & (s.ObjectData("SizeH")) & "Actual: " & Round(s.SizeHeight, 3)
        s.SizeWidth = area / Round(s.SizeHeight, 3)
        s.GetSize w, h
        s.ObjectData("SizeW").Value = Round(w, 3)
        s.ObjectData("SizeH").Value = Round(h, 3)
        s.ObjectData("Area").Value = Round(Round(w, 3) * Round(h, 3), 3)
    ElseIf CDbl(s.ObjectData("SizeW")) <> Round(s.SizeWidth, 3) Then
        MsgBox "SizeW is Different"
        s.SizeHeight = area / Round(s.SizeWidth, 3)
        s.GetSize w, h
        s.ObjectData("SizeW").Value = Round(w, 3)
        s.ObjectData("SizeH").Value = Round(h, 3)
        s.ObjectData("Area").Value = Round(Round(w, 3) * Round(h, 3), 3)
    End If
Else
    Exit Sub
End If

End Sub

Private Sub CheckDataItem(diName As String)

Dim bFound As Boolean
Dim df As DataField

bFound = False

For Each df In ActiveDocument.DataFields
    If df.Name = diName Then
        bFound = True
        Exit For
    End If
Next df

If bFound = False Then ActiveDocument.DataFields.Add diName, , True, True

End Sub
'--------------------------------------------------------------

Well at least it is a start,

Shelby

Shelby,

Thank you for taking the time to respond to my post and for your macro code.

I must admit that I have no idea of how to use your macro since I know nothing about VB. I will need more information about VB to take advantage of your generous effort. An investigative visit to Barns & Noble is in order.

I'm certain that many more people than just myself would love to have this functionality in the program.

Regards,
Chester

[shelbym]

Chester I put the code into a GMS file for you. I have only tested this with CorelDRAW X3. Place this file here: "C:\Program Files\Corel\CorelDRAW Graphics Suite 13\Draw\GMS"

Then make sure the Delay VBA is unchecked: Tools| Options| Workspace| VBA| Delay Load VBA

To make it work select a shape like a rectangle. Then run the macro by doing: Tools| Visual Basic| Play MakeMeFixedArea()

Now if you try and resize the rectangle by say the height, the width will change to keep the area what it was. If you want to turn it off for the shape run the other macro.

Hope that makes a little more sense,

Shelby