OberonPlace.com Forums  

Go Back   OberonPlace.com Forums > Developer Forums > VBA > CorelDRAW/Corel DESIGNER VBA

Thread Tools Search this Thread Display Modes
Old 06-05-2006, 19:02
knowbodynow knowbodynow is offline
Senior Member
Join Date: Mar 2006
Location: Hatsukaichi near Hiroshima
Posts: 434
Default Randomising a text string

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.


Chris (Hunt)
Reply With Quote
Old 06-05-2006, 21:04
shelbym's Avatar
shelbym shelbym is offline
Senior Member
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,791
Blog Entries: 15
Send a message via ICQ to shelbym Send a message via AIM to shelbym Send a message via MSN to shelbym Send a message via Yahoo to shelbym
Default Scrambled Text Around Circle

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

    Optimization = False
    Exit Sub

    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

End Function
Reply With Quote
Old 06-05-2006, 21:48
knowbodynow knowbodynow is offline
Senior Member
Join Date: Mar 2006
Location: Hatsukaichi near Hiroshima
Posts: 434

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,

Reply With Quote
Old 07-05-2006, 07:15
wOxxOm's Avatar
wOxxOm wOxxOm is offline
Senior Member
Join Date: Mar 2005
Posts: 836

Originally Posted by shelbym
Cool Looks like I beat wOxxOm to a solution.
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
Reply With Quote

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
Striping a word down to the first letter only knowbodynow CorelDRAW/Corel DESIGNER VBA 9 19-04-2007 15:14
Select specified text, change font size? fiddler2b CorelDRAW/Corel DESIGNER VBA 3 23-04-2006 08:11
Adding text via VBA knowbodynow CorelDRAW/Corel DESIGNER VBA 2 03-03-2006 09:15
Text selection and sizing ddonnahoe CorelDRAW/Corel DESIGNER VBA 5 17-05-2005 13:19
Reset text after text compression. Bellekom CorelDRAW/Corel DESIGNER VBA 2 05-05-2004 06:14

All times are GMT -5. The time now is 10:43.

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