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 18-10-2011, 01:53
noj noj is offline
Member
 
Join Date: Oct 2011
Location: Sydney
Posts: 31
Default For...Each...Next question

Hi,
I'm a beginner. I was hoping someone could show me how to select a range of shapes that were created within a For...Each...Next statement. Each instance of the statement creates a group of objects and what I want to do at the end of the statement is have some code that selects each group of objects that were created, ungroup them all and then regroup them into one group of objects.

eg, if the first 'For...Each' instance creates a group of 10 objects, the second instance a group of 8 objects and the third and final instance creates a group of 6 objects, I'd like to be able to finish up with a group of 24 objects.

Any help would be appreciated, thanks,
Jon.

Here is my code:

Sub LightsFillContour()
Sub LightsFillContour()
Dim s1 As ShapeRange
Set s1 = ActiveSelectionRange
If s1.Count = 0 Then
Beep
MsgBox "First select the shape you wish to fill", vbOKOnly, "Nothing selected"
Exit Sub
ElseIf s1.Count > 1 Then
Beep
MsgBox "Select one object at a time", vbOKOnly, "Invalid selection"
Exit Sub
ElseIf s1(1).IsSimpleShape = False Then
Beep
MsgBox "First remove selection from any groups", vbOKOnly, "Invalid selection"
Exit Sub
End If
If s1(1).Type <> cdrCurveShape Then
s1(1).ConvertToCurves
End If
If s1(1).Curve.Closed = False Then
Beep
MsgBox "Selection must be a closed object", vbOKOnly, "Invalid selection"
Exit Sub
End If
ActiveDocument.Unit = cdrMillimeter
A: Dim Inline As Variant
Inline = InputBox("Enter the distance in from the edge you want the contour to start (mm)", "Buffer amount", 20)
If Inline = "" Then
Exit Sub
ElseIf Inline <= 0 Then
MsgBox "Enter a number greater than zero", vbOKOnly, "Invalid amount"
GoTo A
Else
Dim eff1 As Effect, sr1 As ShapeRange
Set eff1 = s1(1).CreateContour(cdrContourInside, Inline / ActiveDocument.WorldScale, 1, cdrDirectFountainFillBlend, CreateCMYKColor(0, 0, 0, 100), CreateCMYKColor(0, 0, 0, 100), CreateCMYKColor(0, 0, 0, 100), 0, 0, cdrContourSquareCap, cdrContourCornerMiteredOffsetBevel, 15#)
Set sr1 = eff1.Separate
Dim eff2 As Effect, sr2 As ShapeRange
Set eff2 = sr1(1).CreateContour(cdrContourInside, 47 / ActiveDocument.WorldScale, 50, cdrDirectFountainFillBlend, CreateCMYKColor(0, 0, 0, 100), CreateCMYKColor(0, 0, 0, 100), CreateCMYKColor(0, 0, 0, 100), 0, 0, cdrContourSquareCap, cdrContourCornerMiteredOffsetBevel, 15#)
Set sr2 = eff2.Separate
Dim sr3 As ShapeRange
Set sr3 = sr2.UngroupAllEx
End If
Dim cont As Shape
For Each cont In sr3
Dim cir1 As Shape
Set cir1 = ActiveLayer.CreateEllipse2(0, 0, 5 / ActiveDocument.WorldScale)
cir1.Fill.UniformColor.CMYKAssign 0, 0, 0, 100
cir1.Outline.SetNoOutline
cir1.ConvertToCurves
ActiveDocument.ReferencePoint = cdrCenter
Dim cir2 As Shape
Set cir2 = cir1.Duplicate
cir2.Move 3 / ActiveDocument.WorldScale, 3 / ActiveDocument.WorldScale
cir2.Fill.UniformColor.CMYKAssign 0, 0, 0, 0
cir2.AddToSelection
Dim bulb1 As Shape
Set bulb1 = ActiveSelection.Group
With bulb1
.RotationCenterX = 3 / ActiveDocument.WorldScale
.RotationCenterY = 3 / ActiveDocument.WorldScale
End With
Dim bulb2 As Shape
Set bulb2 = bulb1.Duplicate(50 / ActiveDocument.WorldScale, 0)
Dim steps As Long
If Round((cont.Curve.Length) / (50 / ActiveDocument.WorldScale)) - 2 < 1 Then
steps = 1
Else
steps = Round((cont.Curve.Length) / (50 / ActiveDocument.WorldScale)) - 2
End If
Dim eff3 As Effect
Set eff3 = bulb1.CreateBlend(bulb2, steps, cdrDirectFountainFillBlend, cdrBlendSteps, 0, 0#, False, cont, False, 0, 0, False)
eff3.Blend.BlendGroup.AddToSelection
Dim sr4 As ShapeRange
Set sr4 = ActiveSelectionRange.BreakApartEx
bulb1.RemoveFromSelection
bulb2.RemoveFromSelection
Dim sr5 As ShapeRange
Set sr5 = ActiveSelectionRange.UngroupEx
bulb1.AddToSelection
bulb2.AddToSelection
Dim s5 As Shape
Set s5 = ActiveSelection.Group
Next cont

sr3.Delete
End Sub

Last edited by noj; 18-10-2011 at 02:37.
Reply With Quote
  #2  
Old 19-10-2011, 09:24
runflacruiser's Avatar
runflacruiser runflacruiser is offline
Senior Member
 
Join Date: Jun 2009
Location: Pigeon Forge, TN USA
Posts: 811
Default

hi.
When you create a group you create a shape you can either name using s.name or refer to by the staticid.
You can then use findshapes to find all shapes with that staticid or name.

~John
Reply With Quote
  #3  
Old 20-10-2011, 01:53
noj noj is offline
Member
 
Join Date: Oct 2011
Location: Sydney
Posts: 31
Default

Thanks John.
Reply With Quote
  #4  
Old 20-10-2011, 02:44
noj noj is offline
Member
 
Join Date: Oct 2011
Location: Sydney
Posts: 31
Default

In my case there could be hundreds of shapes to select so naming could be too cumbersome, how are staticid's assigned or set to each shape? I'm finding lots of info on how to manipulate shapes using their staticid but how do I assign the staticid to them in the first place? I'm assuming in my case I would give them all the same staticid and then use the FindShape and CreateSelection statements to select them based on this staticid number?
Reply With Quote
  #5  
Old 21-10-2011, 09:02
runflacruiser's Avatar
runflacruiser runflacruiser is offline
Senior Member
 
Join Date: Jun 2009
Location: Pigeon Forge, TN USA
Posts: 811
Default

Hi.
The staticid property is read only. You can't set it.
What you can do is that when you come across a shape you'll need to retrieve laster you can add it's staticid to a string. IE :

myStr = myStr & " " & myShape.StaticID

Then later you can split this string using VBA.Split which converts the string to an arrary and loop through the array to get or reference the shapes needed.

Of course this is only one of many possible ways to do this. You can also use shaperange.add

Off hand I believe findshapes also accepts a comma separated list of static id's. You could do it quiclky like this as well.

~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
question for Alex vlaya CorelDRAW/Corel DESIGNER VBA 3 01-02-2008 10:21
ETC Question!!!! [Please~~~~~] ljesus7 CorelDRAW/Corel DESIGNER VBA 2 08-03-2007 06:45
CreateArtisticText question...... sejal01 CorelDRAW/Corel DESIGNER VBA 1 01-01-2005 14:01
question sejal01 CorelDRAW/Corel DESIGNER VBA 1 22-12-2004 21:27
vba question bumblebee CorelDRAW/Corel DESIGNER VBA 4 04-08-2004 15:07


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


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