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

[tohaa]

Здравствуйте.
Есть макрос расставляющий эллипсы в точке клика мыши.

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_]

Гм, а зачем такой бесполезный макрос? Чисто мультфильм показать?

 

[Gad]

Гм, а зачем такой бесполезный макрос? Чисто мультфильм показать?

Сначала тоже так подумал Но по ходу ТС хочет если ошибся, откатить все действия по ESC

 

[_MBK_]

Тогда б логичнее проще и правильнее undo делать через command group

 

[tohaa]

Гм, а зачем такой бесполезный макрос? Чисто мультфильм показать?

Да. Показывать мультфильм. Для визуальной проверки размера объектов. А потом все следы удалять.

 

[tohaa]

Несколько объектов на листе могут иметь одинаковое имя?

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

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

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

 

[_MBK_]

Присваивайте создаваемым элипсам некий признак (проще всего имя) а потом удаляйте скопом в процедуре удаления по этому признаку.
Или добавляйте-удаляйте вообще в одной процедуре.

 

[tohaa]

разобрался с именованием, поиском и удалением по имени.

как выполнить удаление по нажатию клавиши 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]

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

 

[lev]

Проще при создании добавлять в коллекцию, а при окончании её удалять
Дублирование отвинтил, можете вернуть, ничего особо не поменяется.

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_]

разобрался с именованием, поиском и удалением по имени.

как выполнить удаление по нажатию клавиши 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

Это непросто но возможно

Loop until keyboard press - CorelDRAW and Corel DESIGNER API - Developer Area - CorelDRAW Community

community.coreldraw.com

 

[DukereD]

activedocument.begincommandgroup
activedocument.endcommandgroup
activedocument.undo

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

 

[_MBK_]

Тогда б логичнее проще и правильнее undo делать через command group