Have a project for special needs kids
Creating 100 dot to dot picture - ie join the dots by moving through numbers or letters.
Any time saving methods greatly apreciated..
The graphic outlines are not the issue the dot and path creation is...
Great, Pranderson. Congrats.
Hi.
That's excellent Patti. You are the blend master, of course.
Here's a macro to accent Patti's method. It will auto-number all points on your blend. Use before breaking apart blend, select blend and run. Enjoy!
~John
Sub blendNumber() Dim sr As ShapeRange, sText As Shape, s As Shape Dim i&, dSize#, x#, y#, j&, xOffset#, yOffset# ActiveDocument.ReferencePoint = cdrTopLeft dSize = 9 'font size xOffset = -0.1 yOffset = 0.1 i = 1 ActiveDocument.BeginCommandGroup "Number Blend" For Each s In ActivePage.Shapes If s.Type = cdrBlendGroupShape Then If i = 1 Then s.Effect.Blend.StartShape.GetPosition x, y Set sText = ActiveLayer.CreateArtisticText(x + xOffset, y + yOffset, CStr(i), , , , dSize) i = i + 1 End If For j = s.Effect.Blend.BlendGroup.Shapes.count To 1 Step -1 s.Effect.Blend.BlendGroup.Shapes(j).GetPosition x, y Set sText = ActiveLayer.CreateArtisticText(x + xOffset, y + yOffset, CStr(i), , , , dSize) i = i + 1 Next j s.Effect.Blend.EndShape.GetPosition x, y Set sText = ActiveLayer.CreateArtisticText(x + xOffset, y + yOffset, CStr(i), , , , dSize) End If Next s ActiveDocument.EndCommandGroupEnd Sub
Thankyou so very much
Patti.. I am smiling - was getting very sore wrist from endlessly clicking..
.....John.
Could I also ask what line in the macro to change to increment the alpha characters.
use both numbering and a -z
I am so very grateful...
Try this variation:
Option ExplicitSub blendNumber() Dim sr As ShapeRange, sText As Shape, s As Shape Dim i&, dSize#, x#, y#, j&, xOffset#, yOffset#, strABC$ ActiveDocument.ReferencePoint = cdrTopLeft dSize = 9 'font size xOffset = -0.1 yOffset = 0.1 i = 1 ActiveDocument.BeginCommandGroup "Number Blend" For Each s In ActivePage.Shapes If s.Type = cdrBlendGroupShape Then If i = 1 Then strABC = ColLett(i) s.Effect.Blend.StartShape.GetPosition x, y Set sText = ActiveLayer.CreateArtisticText(x + xOffset, y + yOffset, strABC, , , , dSize) i = i + 1 End If For j = s.Effect.Blend.BlendGroup.Shapes.count To 1 Step -1 strABC = ColLett(i) s.Effect.Blend.BlendGroup.Shapes(j).GetPosition x, y Set sText = ActiveLayer.CreateArtisticText(x + xOffset, y + yOffset, strABC, , , , dSize) i = i + 1 Next j strABC = ColLett(i) s.Effect.Blend.EndShape.GetPosition x, y Set sText = ActiveLayer.CreateArtisticText(x + xOffset, y + yOffset, strABC, , , , dSize) End If Next s ActiveDocument.EndCommandGroupEnd SubPrivate Function ColLett(Col&) As String If Col > 26 Then ColLett = ColLett((Col - (Col Mod 26)) / 26) + Chr(Col Mod 26 + 64) Else ColLett = Chr(Col + 64) End IfEnd Function
Thankyou again... Can I add a circle with each of the increments ie one event to create the dot and number or alpha character..? ( I live in hope )
Also if its curved the offset (have tried a few changes but get this result