Поворот объекта "по линейке"

  • Автор темы Автор темы _MBK_
  • Дата начала Дата начала
Статус
Закрыто для дальнейших ответов.
_MBK_

_MBK_

Пикирующий бомбардировщик
Топикстартер
15 лет на форуме
Сообщения
33 703
Реакции
11 005
Довольно часто бывает нужно повернуть объект (например криво остканированый битмап) не на определенный угол, а, чтобы определенные линии на нем стали строго горизонтальными или вертикальными. Стандартным инструментом это несколько неудобно: надо выставлять центр поворота, направляющие, да и то "на глаз" не сразу попадешь.
А в фотошопе для этого есть чудесный инструмент - линейка. Рисуешь линеечку поверх линии, которую выровнять надо а затем поворачиваешь изображение по ней - секундное дело.
Нет ли в кореле подобного скрипта? Пишется в общем-то элементарно, зато пользы сколько. Неужели никто не реализовал до сих пор?
 
Ответ: Поворот объекта "по линейке"

А зачем именно скрипт? Имхо устарели они. Но раз так хочется:
Код: 
'2 click rotate.csc
withobject "coreldraw.automation.9"
dim x(2)
dim y(2)
.SetReferencePoint 9
for i=1 to 2
.GetUserClick nX&,nY&
x(i)=nx
y(i)=ny
next i
dx=x(2)-x(1)
dy=y(2)-y(1)
if dx <>0 then
angle=ANGLECONVERT(2,5,atan(dy/dx))
.RotateObject -angle, -1, 0,0
end if
.setreferencepoint 3
end withobject
Поправить под нужную версию. Где-то и макрос валялся.
Неужели никто не реализовал до сих пор?
Нажмите, чтобы раскрыть...
Судя по дате файла последнюю правку вносил в 2008.
 
Ответ: Поворот объекта "по линейке"

Спасибо, уже сам написал. ;-)
 
Ответ: Поворот объекта "по линейке"

Довольно часто бывает нужно повернуть объект (например криво остканированый битмап)
Нажмите, чтобы раскрыть...

Для не ровно отсканированных изображений также в Corel PHOTO-PAINT поворот по сетке: Меню Adjust->Straighten Image...
 
Ответ: Поворот объекта "по линейке"

Вот мой вариант. Рисуется отрезок, выделяется вместе с объектом, который повернуть надо и запускается скрипт. Вертикальные отрезки выравнивает к вертикали а горизонтальные - к горизонтали, как в фотошопе:
Код: 
Sub Rotate()

ActiveDocument.BeginCommandGroup "Auto rotate"

Dim Sel As ShapeRange, S As Shape, St() As New ShapeRange, Tmp As New ShapeRange
Dim I As Integer, Changed As Boolean, U As Integer, Finded As Boolean

    
    
    If Documents.Count = 0 Then Exit Sub
    ActiveDocument.ReferencePoint = cdrCenter
    Set Sel = ActiveSelectionRange
    If Sel.Count < 2 Then Exit Sub
    
    Line = 0
    
    For I = 1 To Sel.Count
       If Sel(I).Type = cdrCurveShape Then
         If Sel(I).Curve.Nodes.Count = 2 Then Line = I
       End If
    Next I
    
    If Line = 0 Then Exit Sub
    
    If Sel(Line).RightX = Sel(Line).LeftX Then Exit Sub
    If Sel(Line).BottomY = Sel(Line).TopY Then Exit Sub
    
    X1 = Sel(Line).Curve.Nodes(1).PositionX
    X2 = Sel(Line).Curve.Nodes(2).PositionX
    Y1 = Sel(Line).Curve.Nodes(1).PositionY
    Y2 = Sel(Line).Curve.Nodes(2).PositionY
    
    If Abs(Y1 - Y2) > Abs(X1 - X2) Then
     
     If Y2 > Y1 Then
      A = X1
      X1 = X2
      X2 = A
      A = Y1
      Y1 = Y2
      Y2 = A
     End If
     alpha = -Atn((X1 - X2) / (Y2 - Y1)) / 3.14 * 180
     
     
    
    Else
    
    
    If X1 > X2 Then
      A = X1
      X1 = X2
      X2 = A
      A = Y1
      Y1 = Y2
      Y2 = A
    End If
    alpha = Atn((Y1 - Y2) / (X2 - X1)) / 3.14 * 180
    
    End If
    
    
    
    
    
    For I = 1 To Sel.Count
      Sel(I).Rotate (alpha)
    Next I
    

ActiveDocument.EndCommandGroup
End Sub

Проверял под X3-X5
 
Статус
Закрыто для дальнейших ответов.
Верх Низ