OberonPlace.com Forums  

Go Back   OberonPlace.com Forums > Corel User Forums > CorelDRAW > Macros/Add-ons

Reply
 
Thread Tools Search this Thread Display Modes
  #1  
Old 17-10-2011, 11:26
buga buga is offline
Senior Member
 
Join Date: Jan 2011
Posts: 114
Default rectangle around (rotation)

Hello such.

I've been doing a test and I made a macro that creates a rectangle around a shape.

I would like to do something more difficult, but not how.

The fact is that I like, that this rectangle have the rotation of the shape, but also were perfectly aligned shape. That is, as if that had been rotated shape after creating the rectangle around. but ... what if the center of rotation, not the center of the shape?

I do not know if I explained well.

Any help for the code?

thank you very much

a greeting
Reply With Quote
  #2  
Old 19-10-2011, 09:32
runflacruiser's Avatar
runflacruiser runflacruiser is offline
Senior Member
 
Join Date: Jun 2009
Location: Pigeon Forge, TN USA
Posts: 811
Default

Hi.
Like this?:

Code:
Sub testRect()
    Dim s As Shape, sRect As Shape
    Dim x#, y#, w#, h#, a#
    ActiveDocument.ReferencePoint = cdrCenter
    EventsEnabled = False
    
    Set s = ActiveShape
    a = s.RotationAngle
    If 360 - a > 0 Then s.Rotate -a
    s.GetBoundingBox x, y, w, h
    Set sRect = ActiveLayer.CreateRectangle2(x, y, w, h)
    If 360 - a > 0 Then s.Rotate a: sRect.Rotate a
    EventsEnabled = True
End Sub
~John
Reply With Quote
  #3  
Old 20-10-2011, 04:59
buga buga is offline
Senior Member
 
Join Date: Jan 2011
Posts: 114
Default

first of all, thanks for your code, but does not work well with text

if you create a text field and run the macro, then clones the text and convert it to curves and run the macro, check that the rectangles do not match.

besides, if you create a text field and run the macro, then rotate the result (text and rectangle) create guidelines around the rectangle.
After selecting the text and run the macro again, you will see that the resulting rectangle does not match the first, nor match the guidelines, but appears shifted.
In addition, there is the problem that the rectangle would be different than the resulting rectangle of text converted to curves.

I'm still mulling over the code and I think the problem is in the center of rotation.
I'm pretty close to it. If I succeed I'll post the code.

thanks
Reply With Quote
  #4  
Old 24-10-2011, 12:37
buga buga is offline
Senior Member
 
Join Date: Jan 2011
Posts: 114
Default

Maybe you can improve, but it works

Code:
Sub CreateMyRectanlgeRotation()
    ActiveDocument.Unit = cdrMillimeter
    Dim sr As Shape, srClone As Shape
    Dim srSelection As Shape, sRect As Shape
    Dim srDupli As Shape
    Dim x As Double, y As Double
    Dim w As Double, h As Double
    Dim dx As Double, dy As Double
    Dim Dw As Double, Dh As Double
    Dim Cx As Double, Cy As Double
    Dim Cw As Double, Ch As Double
    Dim dAngle As Double
    Dim CenX As Double, CenY As Double
    Dim Margen As Double

    
    ActiveDocument.Unit = cdrMillimeter
    ActiveDocument.ReferencePoint = cdrCenter
    Margen = 0
    Set srSelection = ActiveShape
    srSelection.GetPosition x, y
    srSelection.GetSize w, h
    dAngle = srSelection.RotationAngle
    Set srDupli = srSelection.Clone(0, 0)
    srDupli.Fill.ApplyUniformFill CreateCMYKColor(0, 100, 100, 0)
    CenX = srDupli.RotationCenterX
    CenY = srDupli.RotationCenterY
    srDupli.Rotate -(dAngle)
    'MsgBox "srDupli.RotationAngle: " & ActiveShape.RotationAngle
    srDupli.GetPosition dx, dy
    srDupli.GetSize Dw, Dh
    Set srClone = srDupli.Clone(0, 0)
    srClone.RotationCenterX = CenX
    srClone.RotationCenterY = CenY
    srClone.Fill.ApplyUniformFill CreateCMYKColor(0, 100, 100, 100)
    srClone.ConvertToCurves
    srClone.GetPosition Cx, Cy
    srClone.GetSize Cw, Ch
    Set sRect = ActiveLayer.CreateRectangle2(Cx - (Cw / 2) - (Margen / 2), Cy - (Ch / 2) - (Margen / 2), Cw + Margen, Ch + Margen)
    Red
    sRect.RotationCenterX = CenX
    sRect.RotationCenterY = CenY

    srClone.Rotate dAngle
    sRect.Rotate dAngle
    srDupli.Delete
    srClone.Delete

End Sub
thanks

a greeting
Reply With Quote
  #5  
Old 05-11-2011, 07:24
runflacruiser's Avatar
runflacruiser runflacruiser is offline
Senior Member
 
Join Date: Jun 2009
Location: Pigeon Forge, TN USA
Posts: 811
Default

Hi.
Good job on the code. I see what you mean.
Here's a fixed version of my code above:

Code:
Sub testRect()
    Dim s As Shape, sRect As Shape, sDup As Shape
    Dim x#, y#, w#, h#, a#, x1#, y1#, bUseDup As Boolean
    
    EventsEnabled = False
    ActiveDocument.ReferencePoint = cdrCenter
    Set s = ActiveShape
    a = s.RotationAngle
    If 360 - a > 0 Then s.Rotate -a
    s.GetBoundingBox x, y, w, h
    
    If s.Type = cdrTextShape Then
        Set sDup = s.Duplicate(0, 0): bUseDup = True
        sDup.ConvertToCurves
        sDup.GetBoundingBox x, y, w, h 'transfer bb coords to dup curve shape
    End If
    Set sRect = ActiveLayer.CreateRectangle2(x, y, w, h)
    
    If 360 - a > 0 Then s.Selected = True: ActiveSelection.Rotate a
    If bUseDup Then sDup.Delete
    EventsEnabled = True
End Sub
PS: An absolute BoundingBox for shape size position value when the shape is a text object would be a nice add to the object model.
~John
Reply With Quote
  #6  
Old 06-11-2011, 07:20
buga buga is offline
Senior Member
 
Join Date: Jan 2011
Posts: 114
Default

Test your code in this file. It does not work properly.



Thanks also.

a greeting
Attached Files
File Type: cdr Test.cdr (22.7 KB, 188 views)

Last edited by buga; 06-11-2011 at 07:26.
Reply With Quote
Reply


Currently Active Users Viewing This Thread: 1 (0 members and 1 guests)
 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off

Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
find out the angle of rotation buga Macros/Add-ons 7 27-01-2011 10:22
copy center rotation properties buga Macros/Add-ons 0 20-01-2011 06:21
Precision in rotation vindaa CorelDRAW/Corel DESIGNER VBA 2 02-09-2008 21:05
Rotation and PowerClip Craig Tucker CorelDRAW/Corel DESIGNER VBA 3 23-08-2007 16:31
Rotation Angle norbert_ds CorelDRAW/Corel DESIGNER VBA 1 20-04-2007 02:39


All times are GMT -5. The time now is 03:07.


Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
Copyright © 2011, Oberonplace.com