[CDR X5-X8] Ctrl+K массово

[Григор-313]

Убрал, теперь после запуска макроса, текст становится прозрачным, и как объект не выделяется.
При двойном клике мышкой открывается для редактирования, при выходе снова исчезает....

перестает работать панель инструментов, и только перезагрузка программы.
Файл прикрепил

 

[lev]

Лень возиться с чужим кодом.
Побуквенно я разбиваю так:

Sub breaker()  'не работает с обтеканием текста
  Dim sr As ShapeRange, s As Shape
  Set sr = ActivePage.FindShapes(, cdrTextShape)
  c = 0
  ActiveDocument.BeginCommandGroup "Breaker"
  While Not c = sr.Count
    c = sr.Count
    For Each s In sr
      s.BreakApart
    Next s
    Set sr = ActivePage.FindShapes(, cdrTextShape)
  Wend
  'sr.ConvertToCurves 'раскомментируйте для преобразования в кривые
  ActiveDocument.EndCommandGroup
End Sub

Следущий код для разбиения выделенной многоконтурной кривой на части с сохранением дырок, буквы типа "i", "й" и прочая диакритика разделятся на куски.

Sub splitter()
  Dim s As Shape, r As Rect
  On Error Resume Next
  ActiveDocument.BeginCommandGroup "splitter"
  Set sr = ActiveSelection.Shapes.FindShapes.All.BreakApartEx
  For Each s In sr
    Set r = s.BoundingBox
    Set sel = ActivePage.SelectShapesFromRectangle(r.Left, r.Top, r.Right, r.Bottom, False)
    If sel.Shapes.Count > 1 Then sel.Combine
  Next s
  ActiveDocument.EndCommandGroup
End Sub

 

[Григор-313]

Лень возиться с чужим кодом.
Побуквенно я разбиваю так:

Sub breaker()  'не работает с обтеканием текста
  Dim sr As ShapeRange, s As Shape
  Set sr = ActivePage.FindShapes(, cdrTextShape)
  c = 0
  ActiveDocument.BeginCommandGroup "Breaker"
  While Not c = sr.Count
    c = sr.Count
    For Each s In sr
      s.BreakApart
    Next s
    Set sr = ActivePage.FindShapes(, cdrTextShape)
  Wend
  'sr.ConvertToCurves 'раскомментируйте для преобразования в кривые
  ActiveDocument.EndCommandGroup
End Sub

Следущий код для разбиения выделенной многоконтурной кривой на части с сохранением дырок, буквы типа "i", "й" и прочая диакритика разделятся на куски.

Sub splitter()
  Dim s As Shape, r As Rect
  On Error Resume Next
  ActiveDocument.BeginCommandGroup "splitter"
  Set sr = ActiveSelection.Shapes.FindShapes.All.BreakApartEx
  For Each s In sr
    Set r = s.BoundingBox
    Set sel = ActivePage.SelectShapesFromRectangle(r.Left, r.Top, r.Right, r.Bottom, False)
    If sel.Shapes.Count > 1 Then sel.Combine
  Next s
  ActiveDocument.EndCommandGroup
End Sub

Благодарю вас добрый человек за помощь! Заработало!!!

 

[dastin]

и этот макрос не запускается.

вы вероятно запускаете только только код формы, а переменные обявлены в модуле ...

надо скачать макрос целиком

всё работает - проверил на 2018 и 2025

 

[Григор-313]

вы вероятно запускаете только только код формы, а переменные обявлены в модуле ...
Посмотреть вложение 175846
надо скачать макрос целиком

Посмотреть вложение 175847

всё работает - проверил на 2018 и 2025
Посмотреть вложение 175845

Теперь разобрался. Да работает. Благодарю!
Только осваиваю программу и макросы.
Странно что такие функции не включены в самом CorelDraw

 

[DukereD]

Теперь разобрался. Да работает. Благодарю!
Только осваиваю программу и макросы.
Странно что такие функции не включены в самом CorelDraw

В кореле помимо этого есть куча функций которые "странно почему не включены" иначе половина макросов бы не была написана.

 

[Cutter]

Можно ли прописать макрос который, разъединит все объекты и потом объединит те у которых есть внутренний контур?

Здесь есть плагин "Smart Depart ", он умно делит, сохраняя вложенность, то есть внутренние элементы останутся.