View Single Post
  #9  
Old 21-02-2015, 12:26
shark shark is offline
Senior Member
 
Join Date: Aug 2010
Location: Russia, Belgorod
Posts: 146
Default My macros

Hi
Here is my code. slightly shorter
Code:
Private Sub Break(sBreak As Shape, srStore As ShapeRange)
Dim sPrev As Shape, s As Shape, sr As ShapeRange
    Set sPrev = sBreak.Previous
    Set s = sBreak
    Set sr = s.BreakApartEx
    Do While s.StaticID <> sPrev.StaticID
        If s.Text.Story.Words.Count > 1 Then
            Break s, sr
        Else
            If s.Text.Story.Characters.Count > 2 Then 'how i realized - single character is represented by two textshapes: letter itself and empty shape, don't know why 
                sr.AddRange s.BreakApartEx
            Else
                sr.Add s
            End If
        End If
        Set s = s.Previous
    Loop
    srStore.AddRange sr
End Sub

Sub Break_Text()
Dim sr As ShapeRange, tsr As ShapeRange, sPrev As Shape, s As Shape
    Set s = ActiveShape
    If s Is Nothing Then MsgBox "nothing selected!", vbCritical: Exit Sub
    If s.Type <> cdrTextShape Then MsgBox "Is not text shape!", vbCritical: Exit Sub
    If s.Text.Type <> cdrArtisticText Then s.Text.ConvertToArtistic
    
    Set sr = New ShapeRange
    Break s, sr
    sr.ConvertToCurves
End Sub
Reply With Quote