OberonPlace.com Forums

OberonPlace.com Forums (http://forum.oberonplace.com/index.php)
-   CorelDRAW/Corel DESIGNER VBA (http://forum.oberonplace.com/forumdisplay.php?f=16)
-   -   Grouping (http://forum.oberonplace.com/showthread.php?t=7887)

gebp 12-11-2011 14:07

Grouping
 
I need another one help.

In one public variable I stored shapes, witch was taken from the page. next I do some code. For the end I want select this shapes and group its.
How do this?
Code:

Option Explicit
Public sPage As Shape

sub test()

' for example
'there is 3 shapes
ActiveLayer.CreateRectangle 0, 0, 5, 5, 20, 20, 20, 20
ActiveLayer.CreateRectangle 5, 5, 10, 10, 20, 20, 20, 20
ActiveLayer.CreateRectangle 25, 25, 1, 1, 20, 20, 20, 20


Dim x As Double, y As Double, w As Double, h As Double
ActivePage.GetBoundingBox x, y, w, h

Set sPage = ActivePage.SelectShapesFromRectangle(x, y, x + w, y + h, False)

'[some code]

ActiveLayer.CreateRectangle 15, 15, 10, 10, 20, 20, 20, 20
ActiveLayer.CreateRectangle 30,30, 10, 10, 20, 20, 20, 20

'now there is 5 shapes
'I want select and group that ones witch was on the start the macro
' selecting and group. How ?

sPage.Shapes.All.group  ' <- don't work. How do this.

end sub

I don't express exactly. I don't know how transfer collection of shapes taken from ShapeRange to variable on start of macro,
because then number of shapes and sames objects are change. I want on the end of macro select and group the shapes witch has been on the star of macro in the ShapeRange

shelbym 12-11-2011 16:24

ShapeRange Group
 
Create a new ShapeRange and add each shape to it as you create them. I believe you just wanted the first three shapes to be grouped, so you would do that like this:
Code:

Sub MyTest()
    Dim sr As New ShapeRange
   
    sr.Add ActiveLayer.CreateRectangle(0, 0, 5, 5, 20, 20, 20, 20)
    sr.Add ActiveLayer.CreateRectangle(5, 5, 10, 10, 20, 20, 20, 20)
    sr.Add ActiveLayer.CreateRectangle(25, 25, 1, 1, 20, 20, 20, 20)
   
    sr.Group
   
    ActiveLayer.CreateRectangle 15, 15, 10, 10, 20, 20, 20, 20
    ActiveLayer.CreateRectangle 30, 30, 10, 10, 20, 20, 20, 20
End Sub

If you want the other two shapes part of the group make them look like the first three, then do the sr. Group. Hope that helps.

-Shelby

gebp 13-11-2011 07:51

Thanks for ALL shelbym
You are great and very helpful.

thanks a lot

I have one more question.

If I have (for example) group of two objects witch are a each of them a group of some shapes, how ungroup him.

If I try used "Ungroup" method of ShapeRange (ShapeRange.Ungroup), then I got only shapes not 2 groups of shapes as before of grouping.

shelbym 13-11-2011 22:53

Ungroup
 
ShapeRange.Ungroup should ungroup only one level, ShapeRange.UngroupAll should ungroup all levels, ShapeRange,UngroupEx should ungroup one level and return a ShapeRange, and finally ShapeRange.UngroupAllEx should ungroup all levels and retrun a ShapeRange.

Hope that helps,

-Shelby

gebp 14-11-2011 12:23

I tried all methods of ungroup. Always I have been received a group of ungroup shapes.

Example bellow:
Code:

sub test()
Dim sr1 As New ShapeRange, sr2 As New ShapeRange

Dim s1 As Shape, s2 As Shape, s3 As Shape, s4 As Shape

Set s1 = ActiveLayer.CreateRectangle2(0, 0, 1, 1)
Set s2 = ActiveLayer.CreateArtisticText(0, 0, "Test1")
s1.ConvertToCurves
s2.ConvertToCurves

sr1.Add s1
sr1.Add s2
sr1.Group.Move ActivePage.SizeWidth / 2, ActivePage.SizeHeight / 2

Set s3 = ActiveLayer.CreateRectangle2(0, 0, 2, 1)
Set s4 = ActiveLayer.CreateArtisticText(0, 0, "Test2")
s3.ConvertToCurves
s4.ConvertToCurves

sr2.Add s3
sr2.Add s4
sr2.Group.Move ActivePage.SizeWidth / 2, ActivePage.SizeHeight / 2

Dim x As Double, y As Double, w As Double, h As Double
Dim ss As Shape
Dim spage As Shape
Dim sap As New ShapeRange

ActivePage.GetBoundingBox x, y, w, h


        Set spage = ActivePage.SelectShapesFromRectangle(x, y, x + w, y + h, False)
        For Each ss In spage.Shapes
            sap.Add ss
        Next
sap.Group

sap.Ungroup

end sub



Maybe I am doing something wrong?

shelbym 14-11-2011 15:24

Group
 
You loop and add each shape to your shape range, not the group, so when you upgroup it is correct as you added it. This example should do what you wish:
Code:

Sub test()
    Dim sr1 As New ShapeRange, sr2 As New ShapeRange
    Dim s1 As Shape, s2 As Shape, s3 As Shape, s4 As Shape
    Dim s1Group As Shape, s2Group As Shape
   
    Set s1 = ActiveLayer.CreateRectangle2(0, 0, 1, 1)
    Set s2 = ActiveLayer.CreateArtisticText(0, 0, "Test1")
    s1.ConvertToCurves
    s2.ConvertToCurves
   
    sr1.Add s1
    sr1.Add s2
    Set s1Group = sr1.Group
    sr1.Move ActivePage.SizeWidth / 2, ActivePage.SizeHeight / 2
   
    Set s3 = ActiveLayer.CreateRectangle2(0, 0, 2, 1)
    Set s4 = ActiveLayer.CreateArtisticText(0, 0, "Test2")
    s3.ConvertToCurves
    s4.ConvertToCurves
   
    sr2.Add s3
    sr2.Add s4
    Set s2Group = sr2.Group
    sr2.Move ActivePage.SizeWidth / 2, ActivePage.SizeHeight / 2
   
    Dim sGroup As Shape
   
    Set sGroup = ActiveDocument.CreateShapeRangeFromArray(s1Group, s2Group).Group
     
    sGroup.Ungroup
End Sub

Best of luck,

-Shelby


All times are GMT -5. The time now is 18:30.

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