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 27-06-2011, 01:50
HeauxmBru
Guest
 
Posts: n/a
Default shaperange.add

I am having trouble with the shaperange.add method. I am using it in a For statement with a shape.duplicate(...) method. For some reason I only have 1 shape in the range through the procedure. I've seen this same code in other procedures and it works fine. Just not in mine. I've tried several things but nothing works. I'm not sure what I'm missing.

Here is my code:
Code:
Sub CreateDuplicates()

    Const conX As Double = 0.25540157480315 '   x position of NSI Box
    Const conY As Double = 0.1685           '   y position of NSI Box
    Const conW As Double = 13.7275          '   w width of NSI Box
    Const conH As Double = 10.5449015748032 '   h height of NSI Box
    Const Margin As Double = 0.025            '   Page margin in inches
    Dim s1 As Shape, s2 As Shape
    Dim sr As New ShapeRange
    Dim i As Integer
    Dim x#, y#, w#, h#
    Dim x1#, y1#, w1#, h1#
    Dim xGutter As Double, yGutter As Double
    Dim RowNum As Long, ColNum As Long
    Dim sx As Double, sy As Double          '   new coords for first shape
    Dim d As Document
    
    Set d = ActiveDocument
    
    d.BeginCommandGroup "Create Duplicates"
    
    On Error GoTo ErrHandler
    
    Set s1 = ActiveSelection            '   target shape
    s1.GetBoundingBox x, y, w, h        '   target coords +
    w1 = w
    h1 = h
    
    RowNum = conW / (w + 1 + Margin)
    xGutter = (conW - (w * RowNum)) / (RowNum + 1)
    sx = xGutter + conX
    
    ColNum = conH / (h + 1 + Margin)
    yGutter = (conH - (h * ColNum)) / (ColNum + 1)
    sy = yGutter + conY

    d.DrawingOriginY = d.ActivePage.SizeHeight / 2

    s1.SetPosition sx, -sy
    sr.Add s1
    
    For i = 1 To RowNum - 1
        sr.Add s1.Duplicate(w + xGutter, 0)
'        Set s2 = s1.Duplicate
'        s2.Move w + xGutter, 0
'        s2.Fill.UniformColor.CMYKAssign 0, 100, 0, 0
        s1.Fill.UniformColor.CMYKAssign 0, 100, 0, 0
        w = w + w1 + xGutter
'        MsgBox sr.Count & " shapes", vbOKOnly
    Next i
    
    d.DrawingOriginY = -d.ActivePage.SizeHeight / 2
    
ExitSub:
    d.EndCommandGroup
    Exit Sub
ErrHandler:
    MsgBox "Error occured: " & Err.Description
    Resume ExitSub
    
End Sub
I'd appreciate any suggestions.
Reply With Quote
  #2  
Old 27-06-2011, 13:24
runflacruiser's Avatar
runflacruiser runflacruiser is offline
Senior Member
 
Join Date: Jun 2009
Location: Pigeon Forge, TN USA
Posts: 811
Default

Hi.
Duplicate can be tricky.
The trick is to slowly debug through code and grab your shape as needed.

Try this mod of your loop.

Code:
    For i = 1 To RowNum - 1
        s1.Duplicate 1, 1
        Set s2 = ActiveShape.Next
'       sr.Add s1.Duplicate(w + xGutter, 0)
'       Set s2 = s1.Duplicate
'       s2.Move w + xGutter, 0
        s2.Fill.UniformColor.CMYKAssign 0, 100, 0, 0
        sr.Add s2
        s1.Fill.UniformColor.CMYKAssign 100, , 0, 0
        w = w + w1 + xGutter
'        MsgBox sr.Count & " shapes", vbOKOnly
    Next i
~John
Reply With Quote
  #3  
Old 28-06-2011, 12:49
HeauxmBru
Guest
 
Posts: n/a
Default

John
I tried your suggestion to use .next . I found it interesting and it actually allowed me to have 2 shapes in the shaperange instead of 1. But, sadly, it wasn't enough.

Two problems: 1. .next was picking up a text shape that was on the page instead of the duplicated shape. It actually goes down the list of shapes rather than up (which is where the dups are) so that it picks the next shape behind the shape I am duplicating.
2. It only picks up 1 shape during the loop rather than 1 for every iteration. So I only get 2 shapes in my range rather than all the dups. I was having that same problem before with .add except that I only got 1 shape in the range.

I think somehow I need to be able to reference each dup after the fact, rather than sr.add s1.duplicate. I just don't know how to do that.

The duplication loop is working like I wanted. It makes duplicates of the selected shape and fits as many as can fit in the given space, based on the size of the selected shape. The next step is to do the same thing vertically, but I need all the shapes selected and grouped so I can duplicate downward. That's where it fails as I only have the original (or maybe the last dup) selected.

I'll keep trying till something breaks.

Thanks John
Reply With Quote
  #4  
Old 28-06-2011, 12:54
runflacruiser's Avatar
runflacruiser runflacruiser is offline
Senior Member
 
Join Date: Jun 2009
Location: Pigeon Forge, TN USA
Posts: 811
Default

Hi.
Weird.
I was able to grab both shapes here. Using X5.
I'll take another look also.
~John
Reply With Quote
  #5  
Old 29-06-2011, 01:26
shark shark is offline
Senior Member
 
Join Date: Aug 2010
Location: Russia, Belgorod
Posts: 146
Default

I did not find any mistakes. I've selected one blue rectangle, run this macro and got 7 red rectangles. sr.Count = 8
I do not know why you need this strange copying...
Attached Images
 

Last edited by shark; 29-06-2011 at 01:33.
Reply With Quote
  #6  
Old 29-06-2011, 13:49
HeauxmBru
Guest
 
Posts: n/a
Default

That's what I expected to get. This makes me wonder if something on my machine wacky.
Reply With Quote
  #7  
Old 29-06-2011, 13:54
HeauxmBru
Guest
 
Posts: n/a
Default

Shark
That's what I get using .move not .duplicate. It should have equal spacing throughout. I'm trying to fit whatever size shape multiple times equally spaced in a specific area on the page (11X17), both horizontally and vertically. Everything was good till SR.ADD decided not to add any of the dups.
Reply With Quote
  #8  
Old 29-06-2011, 17:59
HeauxmBru
Guest
 
Posts: n/a
Default

I got an idea. If it works, I'll post the result.
Reply With Quote
  #9  
Old 29-06-2011, 23:02
HeauxmBru
Guest
 
Posts: n/a
Default

Hey guys,

I finally got it to work.

Here's what I did.

Code:
   
 lName = ActivePage.ActiveLayer.Name
    Set lr = ActivePage.CreateLayer("MyLayer")
    lr.Activate
    s1.MoveToLayer lr

    s1.SetPosition sx, -sy
    sr.Add s1
    
    For i = 1 To RowNum - 1
        s1.Duplicate w + xGutter, 0
        w = w + w1 + xGutter
    Next i

    Set sr = ActivePage.ActiveLayer.Shapes.All
    sr.Group.CreateSelection
    
    sr.GetBoundingBox x, y, w, h
    w1 = w
    h1 = h
    
    For i = 1 To ColNum - 1
        s1.Duplicate 0, -h + -yGutter
        h = h + h1 + yGutter
    Next i

    Set sr = ActivePage.ActiveLayer.Shapes.All
    sr.Group.CreateSelection
    sr.Copy
    
    Set lr = ActivePage.Layers.Find(lName)
    lr.Activate
    lr.Paste
    
    ActiveSelection.Ungroup
    d.ClearSelection
    
    ActivePage.Layers.Find("MyLayer").Delete
I still don't understand why sr.add didn't work. Seems like it should've.
Reply With Quote
  #10  
Old 30-06-2011, 01:47
shark shark is offline
Senior Member
 
Join Date: Aug 2010
Location: Russia, Belgorod
Posts: 146
Default

You can use my macros for shape's placement. May be this is that you need.
http://forum.oberonplace.com/showthread.php?t=7563

Last edited by shark; 30-06-2011 at 06:55.
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
Create multiple elements in shaperange(faster) isvaljek Macros/Add-ons 2 24-03-2009 13:06
Shaperange to Layer ebu CorelDRAW/Corel DESIGNER VBA 2 19-01-2008 04:44
Draw X3: VBA: rotate behaviour for shaperange changed wOxxOm CorelDRAW/Corel DESIGNER VBA 0 30-01-2006 12:08


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


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