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 06-05-2006, 20:02
knowbodynow knowbodynow is offline
Senior Member
 
Join Date: Mar 2006
Location: Hatsukaichi near Hiroshima
Posts: 431
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.

Thanks,

Chris (Hunt)
Reply With Quote
  #2  
Old 06-05-2006, 22:04
shelbym's Avatar
shelbym shelbym is offline
Senior Member
 
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,777
Blog Entries: 10
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

Code:
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
Reply With Quote
  #3  
Old 06-05-2006, 22:48
knowbodynow knowbodynow is offline
Senior Member
 
Join Date: Mar 2006
Location: Hatsukaichi near Hiroshima
Posts: 431
Default

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
Reply With Quote
  #4  
Old 07-05-2006, 08:15
wOxxOm's Avatar
wOxxOm wOxxOm is offline
Senior Member
 
Join Date: Mar 2005
Posts: 836
Default

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


All times are GMT -5. The time now is 18:17.


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