When using a scanned image as the basis for a Visio drawing, you often need to scale the image
and rotate it by a small angle. It takes too much time to perform this operation manually with
the desired accuracy. The "Image Resizer" macro provides automatic resizing of the image.

To use the macro, you must know the exact distance between two points in the picture. Points
must be such that after turning they are on the same horizontal.

Method for applying the macro:

1. Add two Connection Points to the points whose distance is known.

2. Connect the added Connection Points with a line and enter the distance as line text. (For
example, 120 m).

3. Select the line and execute the macro.

The macro will resize the shape with embedded image and rotate it to the desired angle so that
the points lie on the same horizontal.

'=======================================================
'============  Resize the Foreign image  ===============
'=======================================================
Sub ImgResizer()
    Dim shp As Visio.Shape
    Dim shp2 As Visio.Shape
    Dim alpha As Double
    Set shp2 = ActiveWindow.Selection(1)    'Measurement Line
    ' Get shp as foreign image
    If shp2.Connects.Count = 2 Then
        Set shp = shp2.Connects(1).ToSheet
        If shp.Type <> 4 Then
            MsgBox "Missing glued image"
            Exit Sub
        End If
    Else
        MsgBox "Wrong Measurement connection"
        Exit Sub
    End If
    ' Resize image
    alpha = shp2.Cells("Angle").Result("deg")
    wV = shp.Cells("Width").Result("m")
    hV = shp.Cells("Height").Result("m")
    w = shp2.Cells("Width").Result("m")
    ' Length should be in Meters (like 120 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

Add comment


Security code
Refresh