Working With Text

[shelbym]

I have tried several variations of this to no avail. Would someone mind looking this over and let me know what I am doing wrong. The basic idea is I am trying to convert all selected text to single line artistic text. (Which is working) Then add the newly broken apart single lines of text back to the shaperange. (Which is not working, as seen by turning it green, it only selects the first line.)

To test this you need to create a couple lines of artistic text, and make one or two more then two lines.

Thanks,

Shelby

Sub WorkingWithText()

Dim s As Shape
Dim srSelection As ShapeRange

Set srSelection = ActiveSelectionRange

For Each s In srSelection
    If s.Type = cdrTextShape Then
        If s.Text.Type = cdrParagraphText Then s.Text.ConvertToArtistic
        If s.Text.Story.Lines.Count > 1 Then srSelection.AddRange s.BreakApartEx()
    End If
Next s

srSelection.ApplyUniformFill CreateCMYKColor(100, 0, 100, 0)

End Sub

[Alex]

Well, the problem is with the BreakApartEx method. The way it works, it performs the break apart operation and then returns the list of selected shapes after the transaction. This works pretty well for most cases except for breaking apart text. When you select a textblock and run Ctrl-K on it, it will break it into lines (or words, characters) and leave only the first line selected. That's why BreakApartEx returns only one shape and not all the resulting lines (well, you guessed it - it's a bug).

The only workaround I can see is to determine what new objects are produced during all the BreakApart calls and then add them back to the range.

Here is a quick method to do this (it is quick to write but not as efficient as it could be to run ).

Sub WorkingWithText()
    Dim s As Shape
    Dim srSelection As ShapeRange
    Dim srStateBefore As ShapeRange
    Dim srStateAfter As ShapeRange
    Set srSelection = ActiveSelectionRange
    
    ' Get all the text objects before the operation
    Set srStateBefore = ActivePage.FindShapes(Type:=cdrTextShape)
    For Each s In srSelection
        If s.Type = cdrTextShape Then
            If s.Text.Type = cdrParagraphText Then s.Text.ConvertToArtistic
            If s.Text.Story.Lines.Count > 1 Then s.BreakApart
        End If
    Next s
    ' And now after the operation
    Set srStateAfter = ActivePage.FindShapes(Type:=cdrTextShape)
    
    ' Any new objects are the ones created by the BreakApart calls
    ' Remove all the "old" objects
    srStateAfter.RemoveRange srStateBefore
    
    ' Now we have the new objects only. Add them to the original range
    srSelection.AddRange srStateAfter
    
    srSelection.ApplyUniformFill CreateCMYKColor(100, 0, 100, 0)
End Sub

Hi Shelby
By no means could I try to solve your problem but I have a question about what it does. By reading the question that you asked it seems like you are trying to create single line text like an engraving machine would use. Is this correct? If it is then how would you export the newly created artwork as it shows on the screen?
My reason for asking is that this would be invaluable for the engraving business to be able to send single line fonts straight from Corel.
By the way your macro for my alignment is saving me a ton of time! I really appreciate all of your work.