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 28-03-2011, 06:15
sagittarius1986
Guest
 
Posts: n/a
Default Macro for selecting paris of objects and grouping them

Hi everyone, i'm new to macro writing, i'm trying to write a macro to select pairs of objects and grouping them.

example:

i have objects numbered Object1, Object2, Object3, ..., Object900.
I need a macro to group objects number 1 and 2, 3 and 4 and so on... can someone please help me?
Reply With Quote
  #2  
Old 28-03-2011, 08:34
runflacruiser's Avatar
runflacruiser runflacruiser is offline
Senior Member
 
Join Date: Jun 2009
Location: Pigeon Forge, TN USA
Posts: 811
Default

Hi.
Before writing any code you need to know how you will tell the script to find the pairs. Example. How will it know to select 1 and 2? By position, item name, etc.
-John
Reply With Quote
  #3  
Old 28-03-2011, 09:41
sagittarius1986
Guest
 
Posts: n/a
Default

Hi, thanks for fast reply, script will have to select those objects like that:

ActiveDocument.CreateSelection ActiveLayer.Shapes(10), ActiveLayer.Shapes(9)

I guess they are somehow numbered, in the document i'm editing are only those shapes i need to group.

~Poul
Reply With Quote
  #4  
Old 28-03-2011, 10:16
runflacruiser's Avatar
runflacruiser runflacruiser is offline
Senior Member
 
Join Date: Jun 2009
Location: Pigeon Forge, TN USA
Posts: 811
Default

Hi.
Can you attach a sample file?
It still isn't clear on how you want to tell the macro which shapes to select.

-John
Reply With Quote
  #5  
Old 29-03-2011, 02:57
sagittarius1986
Guest
 
Posts: n/a
Default

Here's a sample, it's only a small part of the file, i need to group the two lines of text.

I have already grouped the text lines manually, but i have to do this kind of operations pretty often, so writing a macro for this operation would be a bless.

I also need a macro that either centers shapes i choose on grouped text (or objects) and gourp them or paste a copied shape, and centers each newly pasted on grouped text (or other object) and also groups it. Is this kind of macro possible to write? I'm not sure how far a macro can be programmed...
Attached Files
File Type: cdr Rysunek1.cdr (77.9 KB, 245 views)

Last edited by sagittarius1986; 29-03-2011 at 03:28.
Reply With Quote
  #6  
Old 29-03-2011, 07:50
runflacruiser's Avatar
runflacruiser runflacruiser is offline
Senior Member
 
Join Date: Jun 2009
Location: Pigeon Forge, TN USA
Posts: 811
Default

HI.
Try this. Select lines an run. Macro selects and groups items based on y position.

-John

Code:
Sub groupEm()
    Dim s As Shape, sr As ShapeRange, sr2 As ShapeRange
    Dim i&
    
   On Error GoTo groupEm_Error
    myOptimize True, True
    Set sr = doSortSr(ActiveSelectionRange)
    For i = 1 To sr.count
        Set sr2 = New ShapeRange
        sr2.Add sr(i)
        sr2.Add sr(i + 1)
        i = i + 1
        sr2.Group
    Next i
    myOptimize True, False
   On Error GoTo 0
   Exit Sub

groupEm_Error:
    MsgBox "Ended. Odd lines count? Check last single item"
    myOptimize True, False
End Sub

Private Function doSortSr(sr As ShapeRange) As ShapeRange
    Dim srSorted As New ShapeRange
    Dim s As Shape, i&, t, j&, y&, iUpper&
    ReDim theStuffArr#(sr.count - 1, 1)
    For i = 1 To sr.count
        theStuffArr(i - 1, 0) = Round(sr(i).PositionY, 3): theStuffArr(i - 1, 1) = sr(i).StaticID
    Next i
    For i = LBound(theStuffArr, 1) To UBound(theStuffArr, 1) - 1
        For j = LBound(theStuffArr, 1) To UBound(theStuffArr, 1) - 1
            If theStuffArr(j, 0) <= theStuffArr(j + 1, 0) Then
                For y = LBound(theStuffArr, 2) To UBound(theStuffArr, 2)
                    t = theStuffArr(j, y)
                    theStuffArr(j, y) = theStuffArr(j + 1, y): theStuffArr(j + 1, y) = t
                Next y
            End If
        Next
    Next
    For i = 0 To sr.count - 1
        srSorted.Add ActivePage.FindShape(StaticID:=theStuffArr(i, 1))
    Next i
    Set doSortSr = srSorted
End Function

Private Sub myOptimize(bUse As Boolean, Optional bIsStart As Boolean = True)
    If bUse Then
        If bIsStart Then
            Optimization = True
            EventsEnabled = False
            ActiveDocument.SaveSettings
            ActiveDocument.PreserveSelection = False
        Else
            ActiveDocument.PreserveSelection = True
            ActiveDocument.RestoreSettings
            EventsEnabled = True
            Optimization = False
            ActiveWindow.Refresh
        End If
    End If
End Sub
Reply With Quote
  #7  
Old 30-03-2011, 09:32
sagittarius1986
Guest
 
Posts: n/a
Default

Hi,
the script runs perfectly! THANK YOU SOOOO MUCH!

now i need to think of something to paste a copied object and center it on the groupes of the text that the script created any ideas? i need to learn how to write scripts like that... have You spent endless hours on learning how to do it? I'm kind of short on time each day
Reply With Quote
  #8  
Old 30-03-2011, 13:56
runflacruiser's Avatar
runflacruiser runflacruiser is offline
Senior Member
 
Join Date: Jun 2009
Location: Pigeon Forge, TN USA
Posts: 811
Default

Quote:
Originally Posted by sagittarius1986 View Post
Hi,
the script runs perfectly! THANK YOU SOOOO MUCH!
You're very welcome.

Quote:
Originally Posted by sagittarius1986 View Post
now i need to think of something to paste a copied object and center it on the groupes of the text that the script created any ideas?
Duplicate the pasted item? Or different paste each time.


Quote:
Originally Posted by sagittarius1986 View Post
I'm kind of short on time each day
...Story of my life.

-John
Reply With Quote
  #9  
Old 31-03-2011, 00:18
sagittarius1986
Guest
 
Posts: n/a
Default

It's the same object each time, it can be duplicated, or i can copy it and the script could just paste it each time

Every day becomes shorter and shorter, does it not John? More work, more obligations every day... That's just life
Reply With Quote
  #10  
Old 31-03-2011, 07:37
runflacruiser's Avatar
runflacruiser runflacruiser is offline
Senior Member
 
Join Date: Jun 2009
Location: Pigeon Forge, TN USA
Posts: 811
Default

Quote:
Originally Posted by sagittarius1986 View Post
It's the same object each time, it can be duplicated, or i can copy it and the script could just paste it each time

Every day becomes shorter and shorter, does it not John? More work, more obligations every day... That's just life
Hi.
Well summer's on the way! Longer days, more fun!

Try this.
Make sure to have your pasted item on the page somewhere. Select all text groups, run macro, then select pasted item with eyedropper.
Make sure you paste this code in the same module as the above because it uses the same optimization functions.

Code:
Sub addShapeToCenter()

    Dim s As Shape, s1 As Shape, sDup As Shape
    Dim sr As ShapeRange, srFinal As New ShapeRange
    Dim shift As Long
    Dim bClick As Boolean
    Dim bSnap As Boolean
    Dim sHot As Shape
    Dim dTol#, lCnt&, x#, y#
    
    Set sr = ActiveSelectionRange
    If sr.count <= 1 Then MsgBox "Please select all items that will have a shape added to them first": Exit Sub
    
    dTol = 0.01
    bSnap = True
    bClick = False
    
retrySelectItem:
        bClick = ActiveDocument.GetUserClick(x, y, shift, 10, bSnap, cdrCursorEyeDrop)
        If Not bClick Then
            Set sHot = ActivePage.SelectShapesAtPoint(x, y, True, dTol)
            If sHot.Shapes.count = 0 Then
                Dim mRetry As Integer
                mRetry = MsgBox("No shape selected. Trya again?", vbOKCancel, "GDG TextAround")
                If mRetry = 1 Then
                    GoTo retrySelectItem
                Else
                    Exit Sub
                End If
            Else
                ActiveDocument.BeginCommandGroup "Copy to center"
                myOptimize True, True
                Set s1 = sHot.Shapes(1)
                For Each s In sr
                    Set sDup = s1.TreeNode.GetCopy.VirtualShape
                    s1.AlignToShape cdrAlignHCenter, s
                    s1.AlignToShape cdrAlignVCenter, s
                    srFinal.Add sDup
                Next s
                ActiveDocument.LogCreateShapeRange srFinal
                myOptimize True, False
                ActiveDocument.EndCommandGroup
            End If
        End If
End Sub
-John
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
Selecting duplicate objects hywelgharris CorelDRAW/Corel DESIGNER VBA 12 21-05-2010 20:18
selecting objects in a group bloodgroove General 2 19-01-2006 13:11
Sorting and Grouping Objects by Color Joyce Schneider General 1 12-07-2005 01:34
Selecting objects overlapped by other objects Alex FAQ 1 16-05-2005 15:38
VBA Script for CD 11 - Selecting objects with same color Superfreak CorelDRAW/Corel DESIGNER VBA 4 28-01-2003 12:33


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


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