[SOLVED] Skew / Shear a Shape Using Rotation and Non-uniform Scale

[nashwaan]

From my understanding, there is no function in Visio that allows you to skew / shear a shape. 
VisGuy presented a hack by exporting .vsd file to .svg file format and "do manual editing" and then import the edited .svg back into visio to get "skew" effect of the shape (check his post Skewing around with Visio SVG). Brilliant!

However, some Graphics articles state that skew / shear can be achieved by combining Rotations and non-uniform Scaling. (Check this: Representing a Shear as Rotate, Scale, Rotate, Scale and slide 13 on Geometric Transformations and this page 2 Transformation and Viewing)

I tried to implement this algorithm and i am quoting it here:

SHx along y( shx ) = S( sx, sy, 1 ) * Rz( -b ) * S( 1, s, 1 ) * Rz( a )

Where shx >= 0 and the other parameters follow these equations:

a = atan( 1 / (1 + shx) )
s = sqrt( ( 1 + shx ) * ( 1 + shx + shx^2 ) )
b = atan( sqrt( (1 + shx + shx2 ) / (1 + shx ) ) )
sx = sqrt( 1 / ( 1 + shx ) )
sy = sqrt( 1 / (1 + shx + shx^2 ) )

This is my vba code

Code Select Expand


Public Sub TestShear()
    Dim dShearX As Double '// amount of shear along x-axis
    Dim a As Double, b As Double, s As Double, sx As Double, sy As Double
    Dim temp1 As Double, temp2 As Double
   
    '// for the sake of testing, we will make amount of shear same as shape's height
    dShearX = Application.ActiveWindow.Selection(1).Cells("Height").ResultIU
   
    temp1 = 1# + dShearX
    temp2 = 1# + dShearX + dShearX * dShearX
   
    a = Atn(1# / temp1)
    s = Sqr(temp1 * temp2)
    b = Atn(Sqr(temp2 / temp1))
    sx = Sqr(1# / temp1)
    sy = Sqr(1# / temp2)

    Dim width As Double, height As Double
    width = Application.ActiveWindow.Selection(1).Cells("Width").ResultIU
    height = Application.ActiveWindow.Selection(1).Cells("Height").ResultIU
   
    '// because no "Scale" function in Visio, we will adjust the values _
        to make it suitable for "Resize" function
    s = (s * height) - height
    sx = (sx * width) - width
    sy = (sy * height) - height

    Application.ActiveWindow.Selection.rotate a, visRadians
    Application.ActiveWindow.Selection.Union
    Application.ActiveWindow.Selection.Resize visResizeDirN, s, visNoCast
    Application.ActiveWindow.Selection.rotate -b, visRadians
    Application.ActiveWindow.Selection.Union
    Application.ActiveWindow.Selection.Resize visResizeDirE, sx, visNoCast
    Application.ActiveWindow.Selection.Resize visResizeDirN, sy, visNoCast

End Sub

Note, i use union function in the above code to reset rotation (or is there a better way )

below is the result i got using a rectangle (50 x 20) as a test shape. But i don't understand what went wrong!   
I am showing this as step-by-step as i spend very long time trying to debug/fix this.




Any kind of help is very much appreciated (including if you can point me to a link that explains how to drive skew from rotations and scale.  )
Thanks,
Yousuf.

[vojo]

IMHO...it takes alot of work for visio to do this kind of thing....there are alot of implied relationships between cells that arent obvious until you slug it out.

June the 2nd is the expert on this kind of thing.

When did this, I ended up building geometries for each plane and then relating them to each other by having a common reference point.
(probably better ways to do this...but about only way I could make it work)

I tried to stay clear of VBA given all the security issues and having to use templates to share the VBA per se.

more here than you might want need....rt click / double click....but if you look in the shapesheets you can see how I got here (right or wrong).

[Jumpy]

Why not just repaint the Geometry Section and afterward updating the alignment box?
Or am I missing something?

The following example works for simple rectangles, I think.

Code Select Expand


Sub Skew()
Dim ms As String
Dim shp As Visio.Shape
Dim i As Integer, Base As Integer
Dim C1 As Integer, C2 As Integer, Di As String
Dim Am As Double

Set shp = ActiveWindow.Selection(1)
ms = ""

For i = 2 To 5
ms = ms & i - 1 & ". (" & shp.Cells("Geometry1.X" & i).Result("mm") & "/" & shp.Cells("Geometry1.Y" & i).Result("mm") & ")"
ms = ms & " to (" & shp.Cells("Geometry1.X" & i + 1).Result("mm") & "/" & shp.Cells("Geometry1.Y" & i + 1).Result("mm") & ")" & vbCrLf
Next i

ms = ms & "Which line shall be the base?"

Base = InputBox(ms)

Select Case Base

  Case 1:
  C1 = 4
  C2 = 5
 
  Case 2:
  C1 = 5
  C2 = 2
 
  Case 3:
  C1 = 2
  C2 = 3
 
  Case 4:
  C1 = 3
  C2 = 4
 
End Select

Base = InputBox("Skew in direction:" & vbCrLf & "1. X" & vbCrLf & "2. Y")

Select Case Base

  Case 1:
  Di = "X"
 
  Case 2:
  Di = "Y"
 
End Select


Am = InputBox("Distance of shearing in mm:")

shp.Cells("Geometry1." & Di & C1).Result("mm") = shp.Cells("Geometry1." & Di & C1).Result("mm") + Am
shp.Cells("Geometry1." & Di & C2).Result("mm") = shp.Cells("Geometry1." & Di & C2).Result("mm") + Am

ActiveWindow.DeselectAll
ActiveWindow.Select shp, visSelect
Application.ActiveWindow.Selection.UpdateAlignmentBox

End Sub




[Paul Herber]

The article is about applying skew to a bitmap representation of a shape, e.g. an image. Visio defines its shapes as a series of vectors, these can start and end at any point on the shape so any skew transform within Visio would have to do some serious calculations on the shape's geometry section(s). Taking just a plain, simple rectangle shapes, you could design many variations all with subtly different geometries, but all drawing and behaving like a rectangle, non of which would be compatible with any general purpose rectangle skew algorithm. Other shapes would have their own problems as well.
The internals of Visio would be able to create a skew in the same way it can perform rotate/invert/mirror translations on a shape.

[David.P]

Ahhhh amazing! This way, you can skew almost anything easily in Visio (not bitmaps, though).

Simply rotate, join, stretch, rotate back!

Thanks!

[David.P]

... and here you go with skewing bitmaps:

Rotate, cut, paste again as bitmap, stretch, rotate back!

[Nikolay]

Encountered your post recently.

It seems you were almost there; the formulas seem to work actually.
You just had to calculate "Width" and "Height" immediately before transformation (hence twice), and not ahead.
Also you should have taken "dShearX" in relative units, i.e. not in inches (i.e. not use the "ResuiltIU" directly but relatively to the shape size).

The fixed version of the code:

Code Select Expand


Public Sub TestShear()
    Dim dShearX As Double '// amount of shear along x-axis
    Dim a As Double, b As Double, s As Double, sx As Double, sy As Double
    Dim temp1 As Double, temp2 As Double
   
    '// for the sake of testing, we will make amount of shear same as shape's height
    dShearX = 1
   
    temp1 = 1# + dShearX
    temp2 = 1# + dShearX + dShearX * dShearX
   
    a = Atn(1# / temp1)
    s = Sqr(temp1 * temp2)
    b = Atn(Sqr(temp2 / temp1))
    sx = Sqr(1# / temp1)
    sy = Sqr(1# / temp2)

    Dim width As Double, height As Double
   
    Application.ActiveWindow.Selection.Rotate a, visRadians
    Application.ActiveWindow.Selection.Join
   
    width = Application.ActiveWindow.Selection(1).Cells("Width").ResultIU
    height = Application.ActiveWindow.Selection(1).Cells("Height").ResultIU
    s = (s * height) - height
    Application.ActiveWindow.Selection.Resize visResizeDirN, s, visNoCast
   
    Application.ActiveWindow.Selection.Rotate -b, visRadians
    Application.ActiveWindow.Selection.Join
   
    width = Application.ActiveWindow.Selection(1).Cells("Width").ResultIU
    height = Application.ActiveWindow.Selection(1).Cells("Height").ResultIU
    sx = (sx * width) - width
    sy = (sy * height) - height
    Application.ActiveWindow.Selection.Resize visResizeDirE, sx, visNoCast
   
    Application.ActiveWindow.Selection.Resize visResizeDirN, sy, visNoCast

End Sub


[nashwaan]

Thats Awsome Nikolay!

It worked like a charm.   

Thaaaank you a million. You have no idea how much i struggled with this to get it working.

This was one of my long pursued problem. I found another route to solve this problem by using matrices. In this route, a Shear matrix may be decomposed into Rotation and Scale matrices using Singular Matrix Decomposition technique. I implemented half of this algorithm and at some point i just gave up.

Nikolay, you made my day. 

Yousuf.