Homography

[JuneTheSecond]

The other day we have given a question about perspective text at
http://visguy.com/vgforum/index.php?topic=7901.msg33900#msg33900 .
This is also a theme about homography.
There are many documents about homography in the web.
Among them I think the easiest one may be this document at
https://www.codeproject.com/Articles/674433/Perspective-Projection-of-a-Rectangle-Homography .

Referring to this document I tried to make a VBA macro to calculate the location of a point after transformation.
I think it works well, but I cannot yet remind any good idea for user interface for homography, or for perspective text.

Any idea?

Code

Option Explicit

Sub test_Xout_Yout()
    Dim shp As Visio.Shape
    Dim Xin As Double, Yin As Double
    
    Set shp = ActiveWindow.Selection.PrimaryItem
    
    Xin = shp.Cells("Width").Result(visMillimeters) * 0.5
    Yin = shp.Cells("Height").Result(visMillimeters) * 0.5
    
    Set shp = ActiveWindow.Selection.PrimaryItem
    
    Debug.Print Xout(shp, Xin, Yin), Yout(shp, Xin, Yin)
End Sub

Function Xout(shp As Visio.Shape, Xin As Double, Yin As Double) As Double
    Xout = (A(shp) * u(shp, Xin) + B(shp) * v(shp, Yin)) / (G(shp) * u(shp, Xin) + H(shp) * v(shp, Yin) + 1) + X0(shp)
End Function

Function Yout(shp As Visio.Shape, Xin As Double, Yin As Double) As Double
    Yout = (D(shp) * u(shp, Xin) + E(shp) * v(shp, Yin)) / (G(shp) * u(shp, Xin) + H(shp) * v(shp, Yin) + 1) + Y0(shp)
End Function

Function X0(shp As Visio.Shape) As Double
    X0 = shp.Cells("Geometry1.X1").Result(visMillimeters)
End Function

Function X1(shp As Visio.Shape) As Double
    X1 = shp.Cells("Geometry1.X2").Result(visMillimeters)
End Function

Function X2(shp As Visio.Shape) As Double
    X2 = shp.Cells("Geometry1.X3").Result(visMillimeters)
End Function

Function X3(shp As Visio.Shape) As Double
    X3 = shp.Cells("Geometry1.X4").Result(visMillimeters)
End Function

Function Y0(shp As Visio.Shape) As Double
    Y0 = shp.Cells("Geometry1.Y1").Result(visMillimeters)
End Function

Function Y1(shp As Visio.Shape) As Double
    Y1 = shp.Cells("Geometry1.Y2").Result(visMillimeters)
End Function

Function Y2(shp As Visio.Shape) As Double
    Y2 = shp.Cells("Geometry1.Y3").Result(visMillimeters)
End Function

Function Y3(shp As Visio.Shape) As Double
    Y3 = shp.Cells("Geometry1.Y4").Result(visMillimeters)
End Function

Function X00(shp As Visio.Shape) As Double
    X00 = X0(shp) - X0(shp)
End Function

Function X01(shp As Visio.Shape) As Double
    X01 = X1(shp) - X0(shp)
End Function

Function X02(shp As Visio.Shape) As Double
    X02 = X2(shp) - X0(shp)
End Function

Function X03(shp As Visio.Shape) As Double
    X03 = X3(shp) - X0(shp)
End Function

Function Y00(shp As Visio.Shape) As Double
    Y00 = Y0(shp) - Y0(shp)
End Function

Function Y01(shp As Visio.Shape) As Double
    Y01 = Y1(shp) - Y0(shp)
End Function

Function Y02(shp As Visio.Shape) As Double
    Y02 = Y2(shp) - Y0(shp)
End Function

Function Y03(shp As Visio.Shape) As Double
    Y03 = Y3(shp) - Y0(shp)
End Function

Function X12(shp As Visio.Shape) As Double
    X12 = X02(shp) - X01(shp)
End Function

Function Y12(shp As Visio.Shape) As Double
    Y12 = Y2(shp) - Y1(shp)
End Function

Function X32(shp As Visio.Shape) As Double
    X32 = X02(shp) - X03(shp)
End Function

Function Y32(shp As Visio.Shape) As Double
    Y32 = Y02(shp) - Y03(shp)
End Function

Function Gdash(shp As Visio.Shape) As Double
    Gdash = (X02(shp) * Y32(shp) - Y02(shp) * X32(shp)) / (X12(shp) * Y32(shp) - Y12(shp) * X32(shp))
End Function

Function Hdash(shp As Visio.Shape) As Double
    Hdash = (X12(shp) * Y02(shp) - Y12(shp) * X02(shp)) / (X12(shp) * Y32(shp) - Y12(shp) * X32(shp))
End Function

Function A(shp As Visio.Shape) As Double
    A = Gdash(shp) * X01(shp)
End Function

Function D(shp As Visio.Shape) As Double
    D = Gdash(shp) * Y01(shp)
End Function

Function B(shp As Visio.Shape) As Double
    B = Hdash(shp) * X03(shp)
End Function

Function E(shp As Visio.Shape) As Double
    E = Hdash(shp) * Y03(shp)
End Function

Function G(shp As Visio.Shape) As Double
    G = Gdash(shp) - 1
End Function

Function H(shp As Visio.Shape) As Double
    H = Hdash(shp) - 1
End Function

Function u(shp As Visio.Shape, Xin As Double)
    u = Xin / shp.Cells("Width").Result(visMillimeters)
End Function

Function v(shp As Visio.Shape, Yin As Double)
    v = Yin / shp.Cells("Height").Result(visMillimeters)
End Function

[Yacine]

It's about correct isometrics, in case someone thinks something else.

[wapperdude]

It's about correct isometrics...

😱  😕  😁

[vojo]

June...are you creating iso via 2D + control points (like your other shapes)...
or
...using 2013 3D (I don't know to get control points to translate into 3D...standard 2013 transforms don't do it.)

If you are transforming, why not do something like this (fine the middle diagonal pair of control pts...do it again for single pt)
Sort of the theory behind Bezier curves.

user.centerx1 = (controls.row_3.x - controls.row_1.x)/2
same for centery1
user.centerx2 = (controls.row_4.x - controls.row_2.x)/2
same for center y2

more if more control points

user.centerxx = (centerx2-centerx1)/2
user.centeryy = (centery2-centery1)/2

connector.x1 = user.centerxx....user.centeryy

Would that give the center to any regular convex shape (and some concave shapes)?

[Yacine]

😱  😕  😁

You - my buddy - followed me ...
how do you get these funny symbols in your answers?

[wapperdude]

By cheating...well, sort of.  I have a Kindle Fire and these, plus many more, came with it. Never searched, but there must be a slew of emoticons on the internet.

If you've noticed an increase in errors, well, touch screens and I have this raging disagreement...😠  😨

[JuneTheSecond]

Thank you so much for your kind comments.
And then I tried a trial macro to make perspective view.
Here is a short video, please enjoy.
https://youtu.be/UyCPt1GggVg

[wapperdude]

Junichi-san,

That is very nice.  The macro runs so fast that it's almost magic.  This is most impressive development.

Well done!

Wapperdude

[JuneTheSecond]

Thank you, Wapperdude!

Here is another trial using character shape.
And a short video, please enjoy.
https://youtu.be/gcRpLcjqrTE

But I have not yet any good user interface.
Please give me any hint.

[vojo]

in case you were seriously asking

;-)  = semi colon dash close parenthesis
:-) = colon dash close parenthesis
:-0 = colon dash number 0 (or letter o)

[wapperdude]

 . Not sure that's the interface JuneTheSecond meant...could be...

Now, for my guess  ...the interface refers to his control shape.  Here are some ideas....
1) use double click to run the macro
2)  add control point at mid-line to drag line without changing angle
3) maybe some sort of non-modal message box that asks user to select the target shape to be mapped into the "transform" shape.

Just some thoughts.
Wapperdude

[JuneTheSecond]

Thank you guys.
I am sorry I am not clear.
Yes, I am not clear.
I think any user can not use my macro very easy.
I don't think any user don't like to use it to make
the perspective text.
I also feel very hard to prepare all the shapes
to run the macro.

How would you think to use list container
in place of current group?

[wapperdude]

I don't have much time this weekend.  Have only watched the videos so far and not tried the code.

Regarding containers or not...Since I stopped upgrading at V2007, containers of no use.  But, containers is the direction new releases use.

Best,
Wapperdude

[JuneTheSecond]

Thank you so much.
Then I tried a List Container.
User interface is now much better.
Here is a short video, please enjoy.
https://youtu.be/Q-wUc2Do_kY

[wapperdude]

Yes.  That seems much better.

Very nice.  Quite simple. 

Wapperdude