OberonPlace.com Forums  

Go Back   OberonPlace.com Forums > Developer Forums > VBA > CorelDRAW/Corel DESIGNER VBA

Thread Tools Search this Thread Display Modes
Old 22-08-2011, 12:44
Posts: n/a
Default rectangle.setroundness

I have a macro that has run properly in CorelDraw V12, X3 and X4. When I run it in X5, it will not round the corners of a rectangle. I tried the example in the help file:

VBA example
The following VBA example sets the roundness for all corners in the active rectangle to 50%.

Sub Test()
ActiveShape.Rectangle.SetRoundness 50
End Sub

THis does not work either. Also the rectangle.setradius does not work in X5.

Is there a workaround for this?
Reply With Quote
Old 23-08-2011, 02:00
shark shark is offline
Senior Member
Join Date: Aug 2010
Location: Russia, Belgorod
Posts: 146

Inside VBA-editor press F2, then see members of Rectangle-class.
Try use .CornerLowerLeft\CornerLowerRight\CornerUpperLeft\CornerUpperRight or RadiusLowerLeft\ etc.
Reply With Quote
Old 23-08-2011, 19:58
runflacruiser's Avatar
runflacruiser runflacruiser is offline
Senior Member
Join Date: Jun 2009
Location: Pigeon Forge, TN USA
Posts: 811

I was having trouble with this topic a while ago.
I wrote a macro for someone that would adjust the inner rectangles of rectangle inner outer pairs to a certain inset distance.
Seemed when I used mm and no matter what I tried I couldn't get corners to work correctly.
Here's the code I used.

Sub adjustInset()
    Dim s As Shape, sInside As Shape, sr As New ShapeRange, sr2 As ShapeRange
    Dim x#, y#, w#, h#, dInset#, dRad#
    Dim q$
    Dim bSet As Boolean, r As Rectangle
    bSet = False
    EventsEnabled = False
    ActiveDocument.Unit = cdrMillimeter
    dRad = 10 ' set corner radius here but relative corner scaling is on in macro below so I may not be needed.
    dInset# = 3 'you inset value
    q = "@type = 'rectangle' and @com.ParentGroup = null"
    ActiveDocument.BeginCommandGroup "Group Rectangles Contents"
    If ActiveSelection.Shapes.count = 0 And Not bSet Then MsgBox "Select all items and try again.", vbCritical, "GDG"
    Set sr = ActiveSelection.Shapes.FindShapes(Query:=q)
    If sr.count = 0 And Not bSet Then MsgBox "No rectangles or grouped items in your selection, try again.", vbCritical, "GDG"
    bSet = True
    For Each s In sr
            s.GetBoundingBox x, y, w, h
            Set sr2 = New ShapeRange
            sr2.Add s
            Set sr2 = New ShapeRange
            Set sInside = ActivePage.SelectShapesFromRectangle(x, y, x + w, y + h, False)
            If sInside.Shapes.count = 2 Then
                Set sInside = ActiveShape
                sInside.SetBoundingBox x + dInset, y + dInset, w - (dInset * 2), h - (dInset * 2)
                With sInside.Rectangle
                    .RelativeCornerScaling = False
                    .CornerType = cdrCornerTypeScallop
                    .SetRadius 30
                End With
                sInside.Selected = True
                s.Selected = True
                GoTo reGet
            End If
    Next s

    EventsEnabled = True
End Sub
Reply With Quote

rectangle, setroundness, vba

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
Rectangle bug? runflacruiser CorelDRAW/Corel DESIGNER VBA 2 21-07-2011 07:55
Rectangle Corner roundness vindaa CorelDRAW/Corel DESIGNER VBA 9 16-09-2009 17:58
Resizing rectangle without rescaling julvr CorelDRAW/Corel DESIGNER VBA 2 15-05-2009 09:22
4mm rectangle around the object fungel CorelDRAW/Corel DESIGNER VBA 11 06-03-2009 16:47
Create Rectangle-Shape with positioning WernerHo CorelDRAW/Corel DESIGNER VBA 2 06-02-2008 04:40

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

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