[CDR 2022] Сравнение координат выделения и объектов.

  • Автор темы Автор темы tohaa
  • Дата начала Дата начала
T

tohaa

Участник
Топикстартер
Сообщения
232
Реакции
9
Здравствуйте.
Макрос рисует метки по краям выделенных объектов.
Если координата выделения совпадает с координатой объекта - рисуем меточку.

Проблема в том, что координаты всего выделенного sr.GetBoundingBox, по какой-то причине, не всегда совпадают с координатами объектов s.GetBoundingBox

на скрине - нормально отработавщий макрос с группой из 6 прямоугольников и тот же , но перевернутый на 90гр. блок объектов на котором макрос отработал не по всем координатам.

Помогите разобраться как избежать такого 'глюка'

1702328590019.jpeg



Код: 
Sub croporbox()
Dim s As Shape
Dim sr As ShapeRange
Dim X As Double, y As Double, w As Double, h As Double, xb As Double, yb As Double, wb As Double, hb As Double
  
ActiveDocument.Unit = cdrMillimeter
ActiveDocument.ReferencePoint = cdrCenter

Set sr = ActiveSelectionRange

sr.GetBoundingBox xb, yb, wb, hb

For Each s In sr.Shapes

s.GetBoundingBox X, y, w, h

If xb = X Then
ActiveLayer.CreateLineSegment X - 2, y, X - 4, y
ActiveLayer.CreateLineSegment X - 2, y + h, X - 4, y + h
End If

If xb + wb = X + w Then
ActiveLayer.CreateLineSegment X + w + 2, y, X + w + 4, y
ActiveLayer.CreateLineSegment X + w + 2, y + h, X + w + 4, y + h
End If

If yb = y Then
ActiveLayer.CreateLineSegment X, y - 2, X, y - 4
ActiveLayer.CreateLineSegment X + w, y - 2, X + w, y - 4
End If

If yb + hb = y + h Then
ActiveLayer.CreateLineSegment X, y + h + 2, X, y + h + 4
ActiveLayer.CreateLineSegment X + w, y + h + 2, X + w, y + h + 4
End If

Next s

End Sub
 
Если сетки квадратные (а иначе особо ножом насквозь и не порежешь), то проще пробежаться один раз по самым левым объектам и по самым верхним и расставить метки по их краям. и симметрично на противоположную сторону "отразить"
 
ну или как вариант сравнивать координаты через abs(a-b) > N, где N 0.1 например можно использовать или более точно подобрать коэффициент. обычно там расхождение на уровне тысячных если корел так глючит.
 
  • Спасибо
Реакции: tohaa
DukereD сказал(а):
ну или как вариант сравнивать координаты через abs(a-b) > N, где N 0.1 например можно использовать или более точно подобрать коэффициент. обычно там расхождение на уровне тысячных если корел так глючит.
Нажмите, чтобы раскрыть...
Т е. Проблема именно в точности расчетов корела?
 
ну так проверьте ...
воткните перед каждым If что-то типа
MsgBox yb + hb & "=? " & y + h
и воочию убедитесь
 
  • Спасибо
Реакции: tohaa
DukereD сказал(а):
Если сетки квадратные (а иначе особо ножом насквозь и не порежешь), то проще пробежаться один раз по самым левым объектам и по самым верхним и расставить метки по их краям. и симметрично на противоположную сторону "отразить"
Нажмите, чтобы раскрыть...
Отражать не хотел, чтобы можно было "разметить" объекты разного размера.
 
DukereD сказал(а):
ну или как вариант сравнивать координаты через abs(a-b) > N, где N 0.1 например можно использовать или более точно подобрать коэффициент. обычно там расхождение на уровне тысячных если корел так глючит.
Нажмите, чтобы раскрыть...
А вот это отличный вариант! Только не понимаю зачем использовать абсолютное значение числа?

Код: 
sxb = xb + wb
sx = X + w
'MsgBox sxb & " " & sx

If sxb - sx < 0.01 Then
ActiveLayer.CreateLineSegment X + w + 2, y, X + w + 4, y
ActiveLayer.CreateLineSegment X + w + 2, y + h, X + w + 4, y + h
End If
 
Для ответа нужно войти/зарегистрироваться
Верх Низ