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 21-01-2009, 12:13
dear
Guest
 
Posts: n/a
Default Extract object from the group

There are the groups, enclosed one in another.
Please tell me, how take object from one of groups, don't ungroupping other groups

Thank You
Reply With Quote
  #2  
Old 24-01-2009, 19:44
shelbym's Avatar
shelbym shelbym is offline
Senior Member
 
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,782
Blog Entries: 11
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 Extract Shape from Group

This is kinda a lazy way to do it, but I think it should work. Select the shape you want to extract, remember you can use CTRL to get to a single shape in a group or a group of shapes in a group. Then run the code.
Code:
Sub ExtractFromGroup()
    Dim sSelection As Shape
    
    Set sSelection = ActiveShape
    sSelection.Copy
    sSelection.Delete
    ActiveLayer.Paste
End Sub
Basically all the code does it copy the shape to the clipboard, delete it then paste it back. When it is pasted back it is no longer in the group. Yes, lazy I know.

Jeff made a good comment that you could save a line of code and use cut instead.
Code:
Sub ExtractFromGroup()
    Dim sSelection As Shape
    
    Set sSelection = ActiveShape
    sSelection.Cut
    ActiveLayer.Paste
End Sub
-Shelby

Last edited by shelbym; 26-01-2009 at 23:45. Reason: Suggestion use Cut
Reply With Quote
  #3  
Old 26-01-2009, 10:50
dear
Guest
 
Posts: n/a
Default

Thanks a lot for your answer, but can I do this operation without “Copy” and “Paste”?
Reply With Quote
  #4  
Old 26-01-2009, 12:50
SanchoFilin's Avatar
SanchoFilin SanchoFilin is offline
Junior Member
 
Join Date: Jan 2009
Posts: 5
Default

Maybe... ??

Code:
Dim s As Shape, s1 As Shape
Set s1 = s.Duplicate
s.Delete
Reply With Quote
  #5  
Old 26-01-2009, 23:46
shelbym's Avatar
shelbym shelbym is offline
Senior Member
 
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,782
Blog Entries: 11
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 Duplicate

Duplicate was my first thought also, but it doesn't work inside a group, so that is a no go. I think I know another way to do this also, but it requires a bit more code I will see if I can find the time to look at it.

-Shelby
Reply With Quote
  #6  
Old 27-01-2009, 02:59
SanchoFilin's Avatar
SanchoFilin SanchoFilin is offline
Junior Member
 
Join Date: Jan 2009
Posts: 5
Default

Code:
Sub Test()
    Dim s As Shape, g As Shape, s2 As Shape, sr As New ShapeRange
    Set s = ActiveShape
    If s Is Nothing Then MsgBox "Please select an object", vbCritical: Exit Sub
    Set g = s.ParentGroup
    If g Is Nothing Then MsgBox "Please select an object within a group", vbCritical: Exit Sub
    s.name = "myShape"
    g.Duplicate 0, 0
    Set sr = g.UngroupEx
    s.name = ""
    sr.CreateSelection
    s.Selected = False
    ActiveSelection.Delete
    Set s2 = ActiveLayer.FindShape("myShape")
    s2.Delete
    's.OrderForwardOne
    s.CreateSelection
End Sub

Last edited by SanchoFilin; 27-01-2009 at 03:01.
Reply With Quote
  #7  
Old 29-01-2009, 12:11
dear
Guest
 
Posts: n/a
Default

Thanks so much
Reply With Quote
  #8  
Old 03-02-2009, 16:53
Alex's Avatar
Alex Alex is offline
Administrator
 
Join Date: Nov 2002
Posts: 1,940
Blog Entries: 4
Default

Or try this code:

Code:
Public Sub ExtractSelectedFromGroup()
    Dim sObj As Shape
    Dim sGroup As Shape
    
    Set sObj = ActiveShape
    If sObj Is Nothing Then
        MsgBox "Nothing selected", vbCritical
        Exit Sub
    End If
    
    Set sGroup = sObj.ParentGroup
    If sGroup Is Nothing Then
        MsgBox "Selected object is not part of a group", vbCritical
        Exit Sub
    End If
    
    If sGroup.Shapes.Count < 3 Then
        ' Only two (or less) objects in a group.
        ' Should just ungroup everything
        sGroup.Ungroup
    Else
        ' Extract the object and put in in front of the group
        sObj.OrderFrontOf sGroup
    End If
    
    sObj.CreateSelection
End Sub
Reply With Quote
  #9  
Old 03-02-2009, 17:26
shelbym's Avatar
shelbym shelbym is offline
Senior Member
 
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,782
Blog Entries: 11
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 Interesting....

So that is how you do it, you just move it to the front of the stacking order of the group. How very very interesting! THANKS Alex!
Reply With Quote
  #10  
Old 05-02-2009, 11:03
dear
Guest
 
Posts: n/a
Default

Thank you very much
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 Group ungroup it then process and again group derasje Macros/Add-ons 2 19-11-2008 04:04
Extract Multiple Powerclips dungbtl CorelDRAW/Corel DESIGNER VBA 2 15-04-2007 10:06
powerclip extract zaum CorelDRAW/Corel DESIGNER VBA 2 26-10-2005 07:26
How can I extract a piece of a bitmap object using VBA code oswaldon Corel Photo-Paint VBA 2 25-04-2004 19:37
VBA hint to extract CorelDraw images from msWord.doc Henri Socha CorelDRAW/Corel DESIGNER VBA 1 04-04-2003 11:11


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


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