Randomising a text string

[knowbodynow]

Here is another "is it possible?" question! I want to be able to take a word in artistic text, rearrange the letters randomly and then fit the resulting text to a circle so that the letters are still upright (ie. horizontal rather than following the curve of the path). I did a search of the forum but didn't find anything to pilfer. I'm especially stuck on the randomising bit (actually I'm stuck on all of it but that's the bit I'm looking to crack first). Can someone please help - or if it isn't possible tell me so I can avoid hours of fruitless misery.

Thanks,

Chris (Hunt)

[shelbym]

Cool Looks like I beat wOxxOm to a solution. I have to say I had no idea if this was even possible. I don't play much with text. So this gave me a chance to try something new. I believe this code does what you ask. If you have problems or I missed what you were asking let me know. This has been tested to work in CorelDRAW 12 and X3.

If you are new to programing the scramble function might be tough for you, but don't worry about it, learn the easy stuff first.

Simple Features:

1. Selection - Makes sure you have something selected, No more than two objects.
2. Undo - Single Undo for Quick Scramble
3. Optimization - No Blinking, just quick execution of all the steps.
4. Version - Works for CorelDRAW 12 and X3

Sub QuickScramble()

Dim sr As ShapeRange
Dim s As Shape
Dim sText As Shape
Dim sCircle As Shape

If ActiveSelection.Shapes.Count = 0 Then
    MsgBox "Nothing was Selected, Please select Text and Circle.", , "Quick Scramble"
    Exit Sub
ElseIf ActiveSelection.Shapes.Count > 2 Then
    MsgBox "Please select only one line of Artistic Text and one Circle.", , "Quick Scramble"
    Exit Sub
End If

Optimization = True
ActiveDocument.BeginCommandGroup "Quick Scramble"
On Error GoTo ErrHandler
    
Set sr = ActiveDocument.SelectionRange

For Each s In sr
    If s.Type = cdrTextShape Then Set sText = s
    If s.Type = cdrEllipseShape Then Set sCircle = s
Next s

sText.Text.Story = Scramble(sText.Text.Story)

sText.Text.FitToPath sCircle
sText.Effects(1).TextOnPath.Orientation = cdrUprightOrientation

ExitSub:
    Optimization = False
    ActiveWindow.Refresh
    ActiveDocument.EndCommandGroup
    Exit Sub

ErrHandler:
    MsgBox "Error occured: " & Err.Description
    Resume ExitSub

End Sub

Function Scramble(Text As String) As String

Dim X As Long
Dim Position As Long
Dim TempChar As String
  
Scramble = Text

For X = Len(Scramble) To 2 Step -1
   Position = Int(X * Rnd) + 1
   TempChar = Mid$(Scramble, Position, 1)
   Mid$(Scramble, Position) = Mid$(Scramble, X, 1)
   Mid$(Scramble, X) = TempChar
Next

End Function

[knowbodynow]

Thanks shelbym, that's really good - it does exactly what I asked for. The scramble function looks interesting. I hope I can figure out how it works. I can think of various different uses for it. The one problem I have with what I'm working on now is that some of the letters in long words have different colouring - everything reverts to black once the word is scrambled. I'm guessing there is no way around this by scrambling the letters. Perhaps I ought to be looking at pulling the nodes of the base line in a random direction instead? I guess this would keep the colouring of individual letters?

Best wishes,

Chris

[wOxxOm]

Originally Posted by shelbym

Cool Looks like I beat wOxxOm to a solution.

LOL
ROTFL
it's not fair, you know the time shift between our locations is 7 (?) hours ;-)
I must sleep at least some days during a week
btw, I'm glad you did it. Seems like more activity on forum is not bad but very welcome