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 26-05-2003, 03:31
dcsquare
Guest
 
Posts: n/a
Default Fit text to path: extend to the end of path

Hi,

I need to extend a text fitted to a path until the end of the path.
Or, in other words, how can I get the distance from the last character to the last node of the path?

Thanks
Reply With Quote
  #2  
Old 26-05-2003, 07:34
dcsquare
Guest
 
Posts: n/a
Default

I've solved the problem. Here is the code (not the most elegant method, but... it works):

Code:
Sub fit_path()
Dim sh As Shape
Dim x, y
Dim i, max, fsize
max=2
ActiveDocument.Unit = cdrMillimeter
ActiveDocument.ReferencePoint = cdrCenter
For i = ActiveLayer.Shapes.Count To 1 Step -1
    Set sh = ActiveLayer.Shapes(i)
    If sh.Type = cdrCurveShape Then
        If ActiveLayer.Shapes(i - 1).Type = cdrTextShape Then
            ActiveLayer.Shapes(i - 1).Text.FitToPath sh
            x = Abs(ActiveLayer.Shapes(i).PositionX - ActiveLayer.Shapes(i - 1).PositionX)
            y = Abs(ActiveLayer.Shapes(i).PositionY - ActiveLayer.Shapes(i - 1).PositionY)
            While x > max Or y > max
                fsize = ActiveLayer.Shapes(i - 1).Text.Story.Size
                With ActiveLayer.Shapes(i - 1).Text.SpaceProperties
                    .CharacterSpacing = .CharacterSpacing + fsize
                    .WordSpacing = .WordSpacing + fsize
                End With
                If x > Abs(ActiveLayer.Shapes(i).PositionX - ActiveLayer.Shapes(i - 1).PositionX) Then
                    x = Abs(ActiveLayer.Shapes(i).PositionX - ActiveLayer.Shapes(i - 1).PositionX)
                Else: x = 1
                End If
                If y > Abs(ActiveLayer.Shapes(i).PositionY - ActiveLayer.Shapes(i - 1).PositionY) Then
                    y = Abs(ActiveLayer.Shapes(i).PositionY - ActiveLayer.Shapes(i - 1).PositionY)
                Else: y = 1
                End If
            Wend
        Else
            Set sh = ActiveLayer.Shapes(i - 1).Weld(sh)
            sh.OrderBackOf ActiveLayer.Shapes(i - 1)
        End If
    End If
Next i
End Sub
It's a little more complicated because the control curves could be broken, so I needed to weld them.
For the code to work, you need to place the text to be fitted immediately above the control curve in object manager. It works for any number of text and curves that are on the same layer.
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
Text ENCODE Craig Tucker CorelDRAW/Corel DESIGNER VBA 10 26-01-2005 13:59
format text dialog box implement graphicdesigner CorelDRAW/Corel DESIGNER VBA 5 22-12-2004 13:37
Getting the center X on a text shape Rick Randall CorelDRAW/Corel DESIGNER VBA 4 03-08-2004 18:27
Reset text after text compression. Bellekom CorelDRAW/Corel DESIGNER VBA 2 05-05-2004 06:14
Placing a custom envelope on Text larrypanattoni CorelDRAW/Corel DESIGNER VBA 3 23-04-2003 09:18


All times are GMT -5. The time now is 15:23.


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