[CDR X4 и ранее] Макрос по клику мышки

[Igor_SW]

Добрый день! Только учусь макросить, не могу понять, почему в крайней позиции объекты дублируются. Что-то связано со значением "1000", при значении "10" дублируются все позиции. Как исключить дублирование?

Sub Tochki4()
 Dim x As Double, y As Double
 Dim Shift As Long
 Dim b As Boolean
 Dim s As Shape
 Dim s1 As Shape
 Dim s2 As Shape
 Dim s3 As Shape
 Dim q As Double, w As Double
 
 q = 0.02
 w = 0.02

 b = False
 While Not b
  b = ActiveDocument.GetUserClick(x, y, Shift, 1000, False, cdrCursorEyeDrop)
 
   Set s = ActiveLayer.CreateEllipse(x - q, y - q, x + q, y + q)
   s.Fill.ApplyUniformFill CreateRGBColor(255, 0, 0)
   s.Move w, w
 
 Set s1 = ActiveLayer.CreateEllipse(x - q, y - q, x + q, y + q)
   s1.Fill.ApplyUniformFill CreateRGBColor(255, 0, 0)
   s1.Move w, -w
      
 Set s2 = ActiveLayer.CreateEllipse(x - q, y - q, x + q, y + q)
   s2.Fill.ApplyUniformFill CreateRGBColor(255, 0, 0)
   s2.Move -w, w
  
 Set s3 = ActiveLayer.CreateEllipse(x - q, y - q, x + q, y + q)
   s3.Fill.ApplyUniformFill CreateRGBColor(255, 0, 0)
 s3.Move -w, -w
 
 Wend
End Sub

 

[_MBK_]

Что-то связано со значением "1000", при значении "10"

Мда, ребус, достойный лучших форумных вангаторов!

дублируются все позиции.

Что значит дублируются? У вас они просто создаются на одном месте.
Проверяйте фильтр на равенство координат и волосы будут чистыми и шелковистыми

 

[Igor_SW]

Мда, ребус, достойный лучших форумных вангаторов!

Что значит дублируются? У вас они просто создаются на одном месте.
Проверяйте фильтр на равенство координат и волосы будут чистыми и шелковистыми

Попытаюсь другими словами. На последнем клике получаются сдвоенные эллипсы(8 эллипсов). На предыдущих кликах все нормально (4 эллипса), как и задумано.

 

[lev]

У Вас b проверяется циклом wend на true уже после создания кружков, делали бы как в хелповском примере:

    While Not b
        b = ActiveDocument.GetUserClick(x, y, Shift, 1000, False, cdrCursorEyeDrop)
        If Not b Then
          'чего-то делаем
        End If
    Wend

 

[_MBK_]

На последнем клике получаются сдвоенные эллипсы(8 эллипсов).

Вы не поняли мой ответ?

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

Это значит, что после получения текущих координат клика x и y вам надо проверить, а не совпадают ли они с предыдущими значениями? - и только если нет, то рисовать эллипсы.
И, таки да, у вас проверка b стоит уже пост-фактум

 

[Igor_SW]

У Вас b проверяется циклом wend на true уже после создания кружков, делали бы как в хелповском примере:

    While Not b
        b = ActiveDocument.GetUserClick(x, y, Shift, 1000, False, cdrCursorEyeDrop)
        If Not b Then
          'чего-то делаем
        End If
    Wend

Да, вот этого я не учел. Спасибо за науку. А где можно почитать хелповый пример? Во встроенном редакторе VBA поиск по GetUserClick ничего не находит.

 

[lev]

Ставите курсор на GetUserClick, жмёте F1

 

[_MBK_]

Во встроенном редакторе VBA поиск по GetUserClick ничего не находит.

Ну как же не находит

 

[Igor_SW]

Вы не поняли мой ответ?

Это значит, что после получения текущих координат клика x и y вам надо проверить, а не совпадают ли они с предыдущими значениями? - и только если нет, то рисовать эллипсы.
И, таки да, у вас проверка b стоит уже пост-фактум

Ваш ответ про волосы я не понял. А почему появляются одинаковые координаты я и просил объяснить.

 

[Igor_SW]

Ну как же не находит
Посмотреть вложение 85421

Ищу дома в X7 безуспешно. В VB Reference.