[CDR 2020] Поиск объектов по имени и удаление по ESC

tohaa

Участник
Топикстартер
Сообщения
121
Реакции
3
Здравствуйте.
Есть макрос расставляющий эллипсы в точке клика мыши.

Код:
Sub Circleonclick()
Dim x#, y#, b As Boolean, Shift As Long, sr As ShapeRange
ActiveLayer.CreateEllipse 0, 0, 3, 2

   ActiveDocument.ReferencePoint = cdrCenter
   Set sr = ActiveSelectionRange:

If sr.Count = 0 Then Exit Sub
   Do
        b = ActiveDocument.GetUserClick(x, y, Shift, 10, False, cdrCursorWinCross)
        If Not b Then sr.Duplicate.SetPosition x, y
        
   Loop Until b <> False
End Sub

Как его изменить чтобы при нажатии ESC и завершении макроса удалялись все добавленные эллипсы?
 

_MBK_

Пикирующий бомбардировщик
12 лет на форуме
Сообщения
29 872
Реакции
9 814
Гм, а зачем такой бесполезный макрос? Чисто мультфильм показать?
 

_MBK_

Пикирующий бомбардировщик
12 лет на форуме
Сообщения
29 872
Реакции
9 814
Тогда б логичнее проще и правильнее undo делать через command group
 

tohaa

Участник
Топикстартер
Сообщения
121
Реакции
3
Несколько объектов на листе могут иметь одинаковое имя?

пытаюсь именовать эллипс при создании ActiveSelection.Name = "cir"

а потом находить шейпы по имени и удалять. ActivePage.FindShapes(Name:="cir").Delete

Но почему-то удаление не работает.
 

_MBK_

Пикирующий бомбардировщик
12 лет на форуме
Сообщения
29 872
Реакции
9 814
Присваивайте создаваемым элипсам некий признак (проще всего имя) а потом удаляйте скопом в процедуре удаления по этому признаку.
Или добавляйте-удаляйте вообще в одной процедуре.
 

tohaa

Участник
Топикстартер
Сообщения
121
Реакции
3
разобрался с именованием, поиском и удалением по имени.

как выполнить удаление по нажатию клавиши ESC?

Код:
Sub Circleonclick()
Dim x#, y#, b As Boolean, Shift As Long, sr As ShapeRange
Dim cir As Shape

ActiveDocument.Unit = cdrMillimeter
Set cir = ActiveLayer.CreateEllipse(0, 0, 2, 2)
cir.Fill.UniformColor.CMYKAssign 0, 100, 0, 0
cir.Outline.SetNoOutline
cir.Name = "CIR"

ActiveDocument.ReferencePoint = cdrCenter
Set sr = ActiveSelectionRange:
If sr.Count = 0 Then Exit Sub
   Do
        b = ActiveDocument.GetUserClick(x, y, Shift, 10, False, cdrCursorWinCross)
        If Not b Then sr.Duplicate.SetPosition x, y
      
      
   Loop Until b <> False

End Sub

Sub Circleonclick_del()
ActivePage.FindShapes(Name:="CIR").Delete
End Sub
 

Gadalka

15 лет на форуме
Сообщения
2 253
Реакции
764

Не по теме:
Новый слой и играться уже там, по окончании удалить. Не проще?
 

lev

Модератор
15 лет на форуме
Сообщения
2 015
Реакции
1 883
Проще при создании добавлять в коллекцию, а при окончании её удалять
Дублирование отвинтил, можете вернуть, ничего особо не поменяется.

Код:
Sub Circleonclick()
  Dim x#, y#, b As Boolean, Shift As Long
  Dim sr As New ShapeRange

  ActiveDocument.ReferencePoint = cdrCenter

  Do
    b = ActiveDocument.GetUserClick(x, y, Shift, 10, False, cdrCursorWinCross)
    If Not b Then sr.Add ActiveLayer.CreateEllipse2(x, y, 3, 2)
  Loop Until b <> False
  
  sr.Delete
End Sub
 

_MBK_

Пикирующий бомбардировщик
12 лет на форуме
Сообщения
29 872
Реакции
9 814
разобрался с именованием, поиском и удалением по имени.

как выполнить удаление по нажатию клавиши ESC?

Код:
Sub Circleonclick()
Dim x#, y#, b As Boolean, Shift As Long, sr As ShapeRange
Dim cir As Shape

ActiveDocument.Unit = cdrMillimeter
Set cir = ActiveLayer.CreateEllipse(0, 0, 2, 2)
cir.Fill.UniformColor.CMYKAssign 0, 100, 0, 0
cir.Outline.SetNoOutline
cir.Name = "CIR"

ActiveDocument.ReferencePoint = cdrCenter
Set sr = ActiveSelectionRange:
If sr.Count = 0 Then Exit Sub
   Do
        b = ActiveDocument.GetUserClick(x, y, Shift, 10, False, cdrCursorWinCross)
        If Not b Then sr.Duplicate.SetPosition x, y
     
     
   Loop Until b <> False

End Sub

Sub Circleonclick_del()
ActivePage.FindShapes(Name:="CIR").Delete
End Sub
Это непросто но возможно
 

DukereD

Участник
Сообщения
60
Реакции
3
activedocument.begincommandgroup
activedocument.endcommandgroup
activedocument.undo

как-то так видимо