В статье "Автоматизация масштабирования документа" я рассказал о том случае, когда нужно было масштаб документа подстроить под рисунок. Но бывает необходимость и в обратной операции, когда масштаб рисунка жестко задан, а нужно подстроить размеры картинки.
В следующей задаче нужно было отрисовать корабль (палубу). Исходная картинка (хоть и сделана с чертежа) поступает в виде PDF, то есть ни о каком масштабе можно и не говорить. В Visio она перенесена в виде скриншота с фрагмента PDF документа.
Задача - изменить размеры картинки.
Опять прибегаем к линии-измерителю. Но технология немного другая, шейпов в документе больше, поэтому выбираем другой способ совмещения. Измеритель будем выбирать как единственный селектированный шейп, а картинку - как встроенный объект, к которому этот измеритель приклеен. Такой вариант позволит иметь в одном дкоументе множество картинок и каждую можно масштабировать независимо от других.
Процесс:
- Размещаем на картинке точки соединения.
- Клеим измеритель к этим точкам.
- На измерителе текстом указываем его длину.
- Выполняем макрос масштабирования.
Так как сканированная картинка не всегда горизонтальна, приведенный макрос позволяет еще и повернуть ее. Для этого только требуется поставить точки соединения по воображаемой линии, которая в результате должна быть горизонтальной.
Макрос для этого способа оказался гораздо проще, поэтому привожу его текст полностью.
'===================================================================
'================ Resize the background image ===============
'===================================================================
Sub ImgResize()
Dim shp As Visio.Shape
Dim shp2 As Visio.Shape
Dim alpha As Double
Set shp2 = ActiveWindow.Selection(1) 'Measurement Line
Set shp = GetForeignObject
If shp Is Nothing Then Exit Sub
alpha = shp2.Cells("Angle").Result("deg")
wV = shp.Cells("Width").Result("m")
hV = shp.Cells("Height").Result("m")
w = shp2.Cells("Width").Result("m")
w2 = shp2.Text
a = Split(w2, " ")
w3 = CLng(a(0))
Debug.Print w3
k = w3 / w
shp.Cells("Width").Formula = wV * k & " m"
shp.Cells("Height").Formula = hV * k & " m"
Rotate = -(alpha - shp.Cells("Angle").Result("deg"))
shp.Cells("Angle").Formula = Rotate & " deg."
End Sub
Private Function GetForeignObject() As Visio.Shape
Dim shp As Visio.Shape
Set GetForeignObject = Nothing
Set shp = ActiveWindow.Selection(1)
Debug.Print shp.Connects.Count
If shp.Connects.Count = 2 Then
Set shp2 = shp.Connects(1).ToSheet
Debug.Print shp2.Type 'visTypeForeignObject = 4
If shp2.Type = 4 Then Set GetForeignObject = shp2
Else
MsgBox "Wrong Measurement connection"
End If
End Function