[CDR X5-X8] Макрос замены строки текста или удаления строки.

_MBK_ · 25.09.2018

tohaa сказал(а):
как заменять спец символы.

tohaa · 25.09.2018

_MBK_ сказал(а):
Специальные символы в VBA

Вот это через жголову так через жголову! Спасибо!

lev · 25.09.2018

Код:

Sub class_main()
  Dim s As Shape
  Dim l As TextRange
  Dim doreplace As Boolean
  doreplace = False
  For Each s In ActiveLayer.Shapes.FindShapes(Type:=cdrTextShape)
    For Each l In s.Text.Story.Lines
      If doreplace Then l.Text = Replace(l.Text, "class=""""", "class=""main""")
      If InStr(l.Text, "<g id=""main"">") Then doreplace = True
      If InStr(l.Text, "</g>") Then doreplace = False
    Next l
  Next s
End Sub

dastin · 25.09.2018

lev сказал(а):
Код:

да ... всё просто ... когда знаешь

одно небольшое сомнение:
- А не стоит ли поменять местами строки

Код:

If doreplace Then l.Text = Replace(l.Text, "class=""""", "class=""main""")
If InStr(l.Text, "<g id=""main"">") Then doreplace = True

?

tohaa · 25.09.2018

lev сказал(а):

Код:

Sub class_main()
  Dim s As Shape
  Dim l As TextRange
  Dim doreplace As Boolean
  doreplace = False
  For Each s In ActiveLayer.Shapes.FindShapes(Type:=cdrTextShape)
    For Each l In s.Text.Story.Lines
      If doreplace Then l.Text = Replace(l.Text, "class=""""", "class=""main""")
      If InStr(l.Text, "<g id=""main"">") Then doreplace = True
      If InStr(l.Text, "</g>") Then doreplace = False
    Next l
  Next s
End Sub

Добрый вечер! Огромное спасибо!

У меня готов следующий вопрос)

Как заменить значения class="" на class="main", если значения в скобках class="переменное имя стиля ". А нужно чтобы туда подставлялось "main".

tohaa · 25.09.2018

lev сказал(а):

Код:

Sub class_main()
  Dim s As Shape
  Dim l As TextRange
  Dim doreplace As Boolean
  doreplace = False
  For Each s In ActiveLayer.Shapes.FindShapes(Type:=cdrTextShape)
    For Each l In s.Text.Story.Lines
      If doreplace Then l.Text = Replace(l.Text, "class=""""", "class=""main""")
      If InStr(l.Text, "<g id=""main"">") Then doreplace = True
      If InStr(l.Text, "</g>") Then doreplace = False
    Next l
  Next s
End Sub

Этот код меняет class="", "class="main" почему то только два раза .
В интервале
<g id="main"> ...</g> остаются непереименованные class="". Какой-то глюк?

lev · 26.09.2018

tohaa сказал(а):
Как заменить значения class="" на class="main", если значения в скобках class="переменное имя стиля ". А нужно чтобы туда подставлялось "main".

Тут уже желательно регулярки подключать

Код:

Sub cl_main()
  ActiveDocument.BeginCommandGroup "Mainer"
  Set re = CreateObject("VBScript.RegExp")
  re.Pattern = "class="".*?"""
  Dim s As Shape
  Dim l As TextRange
  Dim doreplace As Boolean
  doreplace = False
  For Each s In ActiveLayer.Shapes.FindShapes(Type:=cdrTextShape)
    For Each l In s.Text.Story.Lines
      If doreplace Then
        If re.test(l.Text) Then l.Text = re.Replace(l.Text, "class=""main""")
      End If
      If InStr(l.Text, "<g id=""main"">") Then doreplace = True
      If InStr(l.Text, "</g>") Then doreplace = False
    Next l
  Next s
  ActiveDocument.EndCommandGroup
End Sub

tohaa сказал(а):
В интервале <g id="main"> ...</g> остаются непереименованные class="". Какой-то глюк?

И как на такое отвечать?
Образец текстовки на которой глючит зашлите.

tohaa · 26.09.2018

lev сказал(а):
Тут уже желательно регулярки подключать

Код:

Sub cl_main() ActiveDocument.BeginCommandGroup "Mainer" Set re = CreateObject("VBScript.RegExp") re.Pattern = "class="".*?""" Dim s As Shape Dim l As TextRange Dim doreplace As Boolean doreplace = False For Each s In ActiveLayer.Shapes.FindShapes(Type:=cdrTextShape) For Each l In s.Text.Story.Lines If doreplace Then If re.test(l.Text) Then l.Text = re.Replace(l.Text, "class=""main""") End If If InStr(l.Text, "<g id=""main"">") Then doreplace = True If InStr(l.Text, "</g>") Then doreplace = False Next l Next s ActiveDocument.EndCommandGroup End Sub

И как на такое отвечать?
Образец текстовки на которой глючит зашлите.

Извините . Вот пример кода .
В данном случае производится три замены. Остальные классы не переименовываются. Хотя блок еще не закончился.

<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">

<?xml-stylesheet href="СЂСѓС‡.cdr.css" type="text/css"?>
<svg xmlns="SVG namespace" xml:space="preserve" width="600px" height="600px" version="1.1" style="shape-rendering:geometricPrecision; text-rendering:geometricPrecision; image-rendering:optimizeQuality; fill-rule:evenodd; clip-rule:evenodd"
viewBox="0 0 600 417.5"
xmlns:xlink="XLink namespace">
<g id="main">
<metadata id="CorelCorpID_0Corel-Layer"/>
<g id="_2406420560">
<g>
<path class="fil0 str0" d="M13.44 37.7l20.45 0 0 -10.46 -20.45 0c-3.96,0 -13.4,1.95 -13.4,5.04 0,3.08 9.46,5.42 13.4,5.42z"/>
<path class="fil0 str0" d="M13.44 152.75l20.45 0 0 -10.45 -20.45 0c-3.96,0 -13.4,1.95 -13.4,5.03 0,3.08 9.46,5.42 13.4,5.42z"/>
<path class="fil0 str0" d="M13.44 258.18l20.45 0 0 10.45 -20.45 0c-3.96,0 -13.4,-1.95 -13.4,-5.03 0,-3.09 9.46,-5.42 13.4,-5.42z"/>
<path class="fil0 str0" d="M13.44 402.82l20.45 0 0 -10.45 -20.45 0c-3.96,0 -13.4,1.95 -13.4,5.03 0,3.08 9.46,5.42 13.4,5.42z"/>
</g>
<g>
<path class="fil1 str0" d="M557.1 280.9c0,-0.86 -0.7,-1.56 -1.56,-1.56 -0.87,0 -1.57,0.7 -1.57,1.56l0.02 9.94c0,0.44 -0.17,0.83 -0.46,1.12 -0.29,0.29 -0.68,0.47 -1.11,0.47l-161.07 0.3c-0.39,-0.01 -0.71,-0.05 -0.98,-0.11 -0.26,-0.07 -0.42,-0.15 -0.5,-0.23l0 -0.04c0,-0.04 0.01,-0.09 0.02,-0.14 0.25,-0.94 1.4,-1.82 2.75,-2.58 1.57,-0.87 3.42,-1.53 4.68,-1.97 4.58,-1.61 8.59,0.46 12.89,2.69 1.16,0.59 2.34,1.2 3.63,1.79 0.78,0.36 1.71,0.01 2.07,-0.77 0.36,-0.78 0.01,-1.71 -0.77,-2.07 -1.15,-0.52 -2.33,-1.14 -3.49,-1.73 -4.93,-2.55 -9.51,-4.92 -15.36,-2.87 -1.37,0.49 -3.37,1.21 -5.17,2.2 -2.01,1.12 -3.75,2.59 -4.25,4.52l0 0.01c-0.08,0.29 -0.12,0.58 -0.12,0.86 -0.02,0.81 0.24,1.55 0.78,2.17 0.48,0.54 1.17,0.95 2.07,1.18 0.49,0.13 1.06,0.2 1.69,0.22 53.71,0 107.42,-0.21 161.13,-0.31 1.3,0 2.48,-0.53 3.33,-1.38 0.84,-0.85 1.37,-2.03 1.37,-3.33l-0.02 -9.94z"/>
<path class="fil1 str0" d="M556.85 14.99c0,0.87 -0.7,1.56 -1.56,1.56 -0.87,0 -1.57,-0.69 -1.57,-1.56l0.02 -9.94c0,-0.43 -0.17,-0.83 -0.46,-1.12 -0.29,-0.29 -0.68,-0.47 -1.11,-0.47l-161.07 -0.3c-0.39,0.01 -0.72,0.05 -0.98,0.12 -0.26,0.07 -0.42,0.14 -0.5,0.23l0 0.03c0,0.05 0.01,0.1 0.02,0.15 0.25,0.94 1.4,1.82 2.75,2.57 1.57,0.87 3.42,1.53 4.68,1.98 4.58,1.61 8.59,-0.47 12.89,-2.69 1.16,-0.6 2.34,-1.21 3.63,-1.8 0.78,-0.36 1.71,-0.01 2.07,0.77 0.36,0.79 0.01,1.72 -0.77,2.07 -1.15,0.53 -2.33,1.14 -3.49,1.74 -4.93,2.54 -9.52,4.91 -15.36,2.86 -1.37,-0.48 -3.37,-1.2 -5.17,-2.2 -2.01,-1.11 -3.75,-2.58 -4.25,-4.52l0 0c-0.08,-0.29 -0.12,-0.58 -0.12,-0.86 -0.02,-0.81 0.24,-1.56 0.78,-2.17 0.48,-0.54 1.17,-0.95 2.07,-1.19 0.49,-0.12 1.06,-0.2 1.69,-0.21 53.71,0 107.42,0.2 161.13,0.3 1.3,0 2.47,0.53 3.32,1.39 0.85,0.85 1.38,2.03 1.38,3.32l-0.02 9.94z"/>
<polygon class="fil1 str0" points="92.99,12.61 557.1,12.61 557.1,52.33 92.99,52.33 "/>
<polygon class="fil1 str0" points="17.73,41.12 92.99,52.33 92.99,12.61 17.73,23.82 "/>
<polygon class="fil1 str0" points="557.1,12.61 562.33,12.61 562.33,52.33 557.1,52.33 "/>
<polygon class="fil1 str0" points="562.33,22.02 591.6,22.02 591.6,42.92 562.33,42.92 "/>
<polygon class="fil1 str0" points="599.96,12.61 591.6,12.61 591.6,52.33 599.96,52.33 "/>
<polygon class="fil1 str0" points="92.99,127.66 557.1,127.66 557.1,167.38 92.99,167.38 "/>
<polygon class="fil1 str0" points="17.73,156.17 92.99,167.38 92.99,127.66 17.73,138.87 "/>
<polygon class="fil1 str0" points="557.1,127.66 562.33,127.66 562.33,167.38 557.1,167.38 "/>
<polygon class="fil1 str0" points="562.33,137.07 591.6,137.07 591.6,157.98 562.33,157.98 "/>
<polygon class="fil1 str0" points="599.96,127.66 591.6,127.66 591.6,167.38 599.96,167.38 "/>
<path class="fil1 str0" d="M391.95 138.11l163.06 0c1.15,0 2.09,0.95 2.09,2.1l0 14.63c0,1.15 -0.94,2.09 -2.09,2.09l-163.06 0c-1.15,0 -2.09,-0.94 -2.09,-2.09l0 -14.63c0,-1.15 0.94,-2.1 2.09,-2.1z"/>
<polygon class="fil1 str0" points="92.99,283.26 557.1,283.26 557.1,243.54 92.99,243.54 "/>
<polygon class="fil1 str0" points="17.73,254.75 92.99,243.54 92.99,283.26 17.73,272.05 "/>
<polygon class="fil1 str0" points="557.1,283.26 562.33,283.26 562.33,243.54 557.1,243.54 "/>
<polygon class="fil1 str0" points="562.33,273.86 591.6,273.86 591.6,252.95 562.33,252.95 "/>
<polygon class="fil1 str0" points="599.96,283.26 591.6,283.26 591.6,243.54 599.96,243.54 "/>
<polygon class="fil1 str0" points="92.99,377.73 557.1,377.73 557.1,417.45 92.99,417.45 "/>
<polygon class="fil1 str0" points="17.73,406.24 92.99,417.45 92.99,377.73 17.73,388.94 "/>
<polygon class="fil1 str0" points="557.1,377.73 562.33,377.73 562.33,417.45 557.1,417.45 "/>
<polygon class="fil1 str0" points="562.33,387.14 591.6,387.14 591.6,408.04 562.33,408.04 "/>
<polygon class="fil1 str0" points="599.96,377.73 591.6,377.73 591.6,417.45 599.96,417.45 "/>
</g>
</g>
</g>
<g id="print1">
<metadata id="CorelCorpID_1Corel-Layer"/>
<polygon class="fil2 str1" points="428.93,387.14 428.93,408.04 219.87,408.04 219.87,387.14 "/>
</g>
<g id="print2">
<metadata id="CorelCorpID_2Corel-Layer"/>
<polygon class="fil2 str1" points="543.92,387.14 543.92,408.04 104.89,408.04 104.89,387.14 "/>
</g>
<g id="print3">
<metadata id="CorelCorpID_3Corel-Layer"/>
<polygon class="fil2 str1" points="428.93,252.95 428.93,273.86 219.87,273.86 219.87,252.95 "/>
</g>
<g id="print4">
<metadata id="CorelCorpID_4Corel-Layer"/>
<polygon class="fil2 str1" points="543.92,252.95 543.92,273.86 104.89,273.86 104.89,252.95 "/>
</g>
<g id="print5">
<metadata id="CorelCorpID_5Corel-Layer"/>
<polygon class="fil2 str1" points="428.93,22.02 428.93,42.92 219.87,42.92 219.87,22.02 "/>
</g>
<g id="print6">
<metadata id="CorelCorpID_6Corel-Layer"/>
<polygon class="fil2 str1" points="543.92,22.02 543.92,42.92 104.89,42.92 104.89,22.02 "/>
</g>
<g id="print7">
<metadata id="CorelCorpID_7Corel-Layer"/>
<polygon class="fil2 str1" points="345.31,137.07 345.31,157.98 136.25,157.98 136.25,137.07 "/>
</g>
<g id="print8">
<metadata id="CorelCorpID_8Corel-Layer"/>
<polygon class="fil2 str1" points="376.67,137.07 376.67,157.98 104.89,157.98 104.89,137.07 "/>
</g>
</svg>

lev · 26.09.2018

И где в этом образце class="", которые первый макрос не отлавливает больше двух раз?

Не по теме:
Посетите страничку BB-коды, чтобы научиться убирать простыни под спойлер

tohaa · 26.09.2018

lev сказал(а):
И где в этом образце class="", которые первый макрос не отлавливает больше двух раз?

Не по теме:
Посетите страничку BB-коды, чтобы научиться убирать простыни под спойлер

Страничку посетил. коды понял.

В примере выложил код для обработки макросом, работающим с переменными значениями class. Он по какой-то причине производит две замены из 4.

Вот на этом кусочке удобно попробовать.

lev · 26.09.2018

добавьте строку
Replace s.Text.Story, vbCr, vbCrLf
перед
For Each l In s.Text.Story.Lines

а то перевод каретки не воспринимается как перевод строки, и в текстовки строк попадают произвольные нарезки, в т.ч. и бьющие искомый паттерн на части
В будущем вы можете попасть и на другую проблемку: в исходном образце была открывашка <g id="main"> и закрывашка </g>, а теперь у Вас появились блоки внутри <g id="main">...</g>, где сработает первая попавшаяся </g>, и возможно имеющиеся ещё внутренние блоки обработаны не будут. Переделывать пока лень, возможно у Вас и не возникнет подобной ситуации.

tohaa · 26.09.2018

lev сказал(а):
добавьте строку
Replace s.Text.Story, vbCr, vbCrLf
перед
For Each l In s.Text.Story.Lines

а то перевод каретки не воспринимается как перевод строки, и в текстовки строк попадают произвольные нарезки, в т.ч. и бьющие искомый паттерн на части
В будущем вы можете попасть и на другую проблемку: в исходном образце была открывашка <g id="main"> и закрывашка </g>, а теперь у Вас появились блоки внутри <g id="main">...</g>, где сработает первая попавшаяся </g>, и возможно имеющиеся ещё внутренние блоки обработаны не будут. Переделывать пока лень, возможно у Вас и не возникнет подобной ситуации.

Уже столкнулся с этим. Видимо прийдется тщательно следить за объектами на слое и перекрашивать их в один стиль. А поиск и замену производить по имени стиля. В любом случае огромное Вам спасибо.

tohaa · 26.09.2018

Sub cl_main()
ActiveDocument.BeginCommandGroup "Mainer"
Set re = CreateObject("VBScript.RegExp")
re.Pattern = "class="".*?"""
Dim s As Shape
Dim l As TextRange
Dim doreplace As Boolean
doreplace = False
For Each s In ActiveLayer.Shapes.FindShapes(Type:=cdrTextShape)
Replace s.Text.Story, vbCr, vbCrLf
For Each l In s.Text.Story.Lines
If doreplace Then
If re.test(l.Text) Then l.Text = re.Replace(l.Text, "class=""main""")
End If
If InStr(l.Text, "<g id=""main"">") Then doreplace = True
If InStr(l.Text, "<g id=""print1"">") Then doreplace = False
Next l
Next s
ActiveDocument.EndCommandGroup
End Sub

Добавил строку, но всё равно меняется только два первых значения.

tohaa · 26.09.2018

В одном коде происходит две замены из 10, в другом 5 из 10. Каким-то случайным образом. Не понимаю в чем причина.

tohaa · 27.09.2018

Похоже дело в регулярном выражении.
Имена стилей для замены всегда названы по одному принципу class="fil0 str0" , class="fil1 str0", class="fil1 str1" и т.д.
Подскажите как правильно описать регулярным выражением эти имена.

lev · 27.09.2018

Перевод строки оказался не при чём (регулярка тем более). Видимо строки вычисляются при первом вызове For Each. При замене в живом тексте длина текста меняется и указатель на начало следующей строки попадает не туда. Будем пересобирать текст в отдельную переменную, и уже потом менять весь текст на пересобранный.

Код:

Sub cl_main()
  ActiveDocument.BeginCommandGroup "Mainer"
  Set re = CreateObject("VBScript.RegExp")
  re.Pattern = "class="".*?"""
  Dim s As Shape
  Dim l As TextRange
  Dim doreplace As Boolean
  doreplace = False
  For Each s In ActiveLayer.Shapes.FindShapes(Type:=cdrTextShape)
    For Each l In s.Text.Story.Lines
      ns = l.Text
      If doreplace Then
        If re.test(l.Text) Then ns = re.Replace(l.Text, "class=""main""")
      End If
      If InStr(l.Text, "<g id=""main"">") Then doreplace = True
      If InStr(l.Text, "<g id=""print1"">") Then doreplace = False
      ss = ss & ns
    Next l
    s.Text.Story = ss
  Next s
  ActiveDocument.EndCommandGroup
End Sub

tohaa · 28.09.2018

lev сказал(а):
Перевод строки оказался не при чём (регулярка тем более). Видимо строки вычисляются при первом вызове For Each. При замене в живом тексте длина текста меняется и указатель на начало следующей строки попадает не туда. Будем пересобирать текст в отдельную переменную, и уже потом менять весб текст на пересобранный.

Код:

Sub cl_main() ActiveDocument.BeginCommandGroup "Mainer" Set re = CreateObject("VBScript.RegExp") re.Pattern = "class="".*?""" Dim s As Shape Dim l As TextRange Dim doreplace As Boolean doreplace = False For Each s In ActiveLayer.Shapes.FindShapes(Type:=cdrTextShape) For Each l In s.Text.Story.Lines ns = l.Text If doreplace Then If re.test(l.Text) Then ns = re.Replace(l.Text, "class=""main""") End If If InStr(l.Text, "<g id=""main"">") Then doreplace = True If InStr(l.Text, "<g id=""print1"">") Then doreplace = False ss = ss & ns Next l s.Text.Story = ss Next s ActiveDocument.EndCommandGroup End Sub

Это то что нужно! Три дня ковырялся с этим кусочком, пытаясь понять хоть что-то! Огромное спасибо. Работает. Начинаю внедрять) Вы просто не представляете сколько времени сбережет эта модернизация!

Единственное, что пришлось доделать - все же описать регулярное выражение более точно.
re.Pattern = "class=""fil\d+\sstr\d+"""
иначе макрос в некоторых случаях удалял части кода там где ненужно.

Поиск

[CDR X5-X8] Макрос замены строки текста или удаления строки.

_MBK_

Пикирующий бомбардировщик

tohaa

Участник

lev

Модератор

dastin

Некромант-любитель

tohaa

Участник

tohaa

Участник

lev

Модератор

tohaa

Участник

lev

Модератор

tohaa

Участник

lev

Модератор

tohaa

Участник

tohaa

Участник

tohaa

Участник

tohaa

Участник

lev

Модератор

tohaa

Участник