I'm trying to build a small nesting Function inside of my current working system. What I am having trouble with is that when I add the third shape to the collection and try to position it based on the previous shape added to the collection, it still positions it based on the very first shape. What I end up with is the original in the original position and the copies stacked on top of one another. (I would be particularly interested in what GDG_John has to say about it since I have been using his awesome nesting macro for sometime.)
Function ArrangeImages(ByRef scol1 As Collection, ByRef sA, sB As Shape) Dim i, ii As Long i = scol1.Count If i = 1 Then Set sB = scol1.Item(i) End If If scol1.Count > 1 Then Set sA = sB Set sB = scol1.Item(i) sB.SetPosition sA.PositionX, sA.PositionY + (sA.SizeHeight / 2) + (sB.SizeHeight / 2) + 0.15 End If End Function
Hi bud,
Why not use a shaperange(collection) instead of a generic vba collection? It'll give you access to more of Corels built-in functionality.
For my nesting subs I try to structure the variables I need at the start of the function; using Moving Datums, Static X starting and ending positions etc
If its a simple vertical stack you could use something like below:
Private Function StackNest() Dim YDatum As Double, XDatum As Double Dim Padding As Double: Padding = 0.15 Dim SR As ShapeRange, S As Shape Dim I As Long Set SR = ActiveSelectionRange Set S = SR(1) XDatum = S.CenterX YDatum = S.BottomY - Padding For I = 2 To SR.Shapes.Count Set S = SR(I) S.SetPositionEx cdrTopMiddle, XDatum, YDatum XDatum = S.CenterX YDatum = S.BottomY - Padding Set S = Nothing Next I
Bit of a hack but I can't think of a smoother way...you could do something like below:
I've read conflicting info on the importance of setting variables to nothing when you're done with them but it can cause issues when you reset the same variable repeatedly (on loops etc) so in those instances I always use it.
Option Explicit Private Const Padding As Double = 0.15 Sub StackNest() Dim YDatum As Double, XDatum As Double Dim SR As Shaperange, S As Shape Dim I As Long, GI As Long Dim UngrSR As Shaperange, UngrS As Shape, GrpName As String Set SR = ActiveSelectionRange Set S = SR(1) XDatum = S.CenterX YDatum = S.BottomY - Padding For I = 1 To SR.Shapes.Count Set S = SR(I) If S.Type <> cdrGroupShape Then S.SetPositionEx cdrTopMiddle, XDatum, YDatum YDatum = S.BottomY - Padding Else 'group GrpName = S.Name Set UngrSR = S.UngroupEx For GI = 1 To UngrSR.Shapes.Count Set UngrS = UngrSR(GI) UngrS.SetPositionEx cdrTopMiddle, XDatum, YDatum YDatum = UngrS.BottomY - Padding Set UngrS = Nothing Next GI Set UngrS = UngrSR.Group UngrS.Name = GrpName Set UngrS = Nothing: Set UngrSR = Nothing End If Set S = Nothing Next I Set SR = Nothing End Sub