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

[tohaa]

Здравствуйте.
Макрос рисует метки по краям выделенных объектов.
Если координата выделения совпадает с координатой объекта - рисуем меточку.

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

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

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

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

 

[DukereD]

Если сетки квадратные (а иначе особо ножом насквозь и не порежешь), то проще пробежаться один раз по самым левым объектам и по самым верхним и расставить метки по их краям. и симметрично на противоположную сторону "отразить"

 

[DukereD]

ну или как вариант сравнивать координаты через abs(a-b) > N, где N 0.1 например можно использовать или более точно подобрать коэффициент. обычно там расхождение на уровне тысячных если корел так глючит.

 

[tohaa]

ну или как вариант сравнивать координаты через abs(a-b) > N, где N 0.1 например можно использовать или более точно подобрать коэффициент. обычно там расхождение на уровне тысячных если корел так глючит.

Т е. Проблема именно в точности расчетов корела?

 

[dastin]

ну так проверьте ...
воткните перед каждым If что-то типа
MsgBox yb + hb & "=? " & y + h
и воочию убедитесь

 

[tohaa]

Если сетки квадратные (а иначе особо ножом насквозь и не порежешь), то проще пробежаться один раз по самым левым объектам и по самым верхним и расставить метки по их краям. и симметрично на противоположную сторону "отразить"

Отражать не хотел, чтобы можно было "разметить" объекты разного размера.

 

[tohaa]

ну так проверьте ...
воткните перед каждым If что-то типа
MsgBox yb + hb & "=? " & y + h
и воочию убедитесь

Так и сделаю) пробовал round, авот посмотреть значения не догадался.

 

[tohaa]

ну или как вариант сравнивать координаты через 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

 

[_MBK_]

абсолютное значение числа?

Потому что разница может быть и отрицательная

 

[tohaa]

Потому что разница может быть и отрицательная

и действительно! заработали меточки) Всем спасибо!