OberonPlace.com Forums  

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

Reply
 
Thread Tools Search this Thread Display Modes
  #1  
Old 12-11-2011, 14:07
gebp
Guest
 
Posts: n/a
Default 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

Last edited by gebp; 12-11-2011 at 15:51.
Reply With Quote
  #2  
Old 12-11-2011, 16:24
shelbym's Avatar
shelbym shelbym is offline
Senior Member
 
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,769
Blog Entries: 9
Send a message via ICQ to shelbym Send a message via AIM to shelbym Send a message via MSN to shelbym Send a message via Yahoo to shelbym
Default 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
Reply With Quote
  #3  
Old 13-11-2011, 07:51
gebp
Guest
 
Posts: n/a
Default

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.

Last edited by gebp; 13-11-2011 at 10:36.
Reply With Quote
  #4  
Old 13-11-2011, 22:53
shelbym's Avatar
shelbym shelbym is offline
Senior Member
 
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,769
Blog Entries: 9
Send a message via ICQ to shelbym Send a message via AIM to shelbym Send a message via MSN to shelbym Send a message via Yahoo to shelbym
Default 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
Reply With Quote
  #5  
Old 14-11-2011, 12:23
gebp
Guest
 
Posts: n/a
Default

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?
Reply With Quote
  #6  
Old 14-11-2011, 15:24
shelbym's Avatar
shelbym shelbym is offline
Senior Member
 
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,769
Blog Entries: 9
Send a message via ICQ to shelbym Send a message via AIM to shelbym Send a message via MSN to shelbym Send a message via Yahoo to shelbym
Default 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
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
Macro for selecting paris of objects and grouping them sagittarius1986 Macros/Add-ons 10 01-04-2011 04:57
VBA Grouping Drew CorelDRAW/Corel DESIGNER VBA 0 13-10-2007 12:08
Sorting and Grouping Objects by Color Joyce Schneider General 1 12-07-2005 00:34


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


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