CorelDRAW scripts

Here’s a demo of this macro to apply a descending outline. Just copy the code and paste it into your CorelDRAW scripts.

By Dav ID

Option Explicit

Sub ContornoDecrecientePorPalabra()
    Dim s As Shape
    Dim txt As TextRange
    Dim palabras() As String
    Dim i As Integer
    Dim grosorInicialMM As Double
    Dim grosorInicialIN As Double
    Dim entrada As String
    Dim paso As Double
    If ActiveSelection.shapes.count = 0 Then
        MsgBox "Selecciona un objeto de texto."
        Exit Sub
    End If
    Set s = ActiveSelection.shapes(1)
    If s.Type <> cdrTextShape Then
        MsgBox "La selección no es texto."
        Exit Sub
    End If
    entrada = InputBox("Ingresa el grosor inicial del contorno en mm:", _
                       "Configurar grosor inicial", "1")
    If entrada = "" Then
        grosorInicialMM = 1
    Else
        grosorInicialMM = Val(entrada)
        If grosorInicialMM <= 0 Then grosorInicialMM = 1
    End If
    grosorInicialIN = grosorInicialMM * 0.03937
    palabras = Split(s.Text.Story.Text, " ")
    paso = grosorInicialIN / (UBound(palabras) + 1)
    For i = 0 To UBound(palabras)
        Set txt = s.Text.Story.Words(i + 1)
        txt.Outline.SetProperties Width:=grosorInicialIN - (paso * i)
    Next i
    MsgBox "Contornos aplicados con éxito."
End Sub