В статье "Автоматизация масштабирования документа" я рассказал о том случае, когда нужно было масштаб документа подстроить под рисунок. Но бывает необходимость и в обратной операции, когда масштаб рисунка жестко задан, а нужно подстроить размеры картинки.

В следующей задаче нужно было отрисовать корабль (палубу). Исходная картинка (хоть и сделана с чертежа) поступает в виде 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