Combo Excel and geometry question

[roscoe]

I have a random polygon defined by (x,y) coordinates if each vertex. I have a requirement to generate a duplicate polygon on the inside where each line segment is a set distance away from the outside. For example, I have a box that is 4" on a side. I need to create another box whose line segments are offset to the inside 0.5" (so the new box would be 3" on each side and centered).

If I had to generate this from scratch, my workflow would be something like this:
1) Use the (x,y) coordinates of the ends of each line segment and find the line equation (y=mx+b).
2) Use geometry to calculate a parallel line offset towards the inside of the polygon (y’=mx+b’)
3) Find the intersections (x’,y’) of each of these new line segments

Anybody out there have code that already does this or something similar that I can edit? Are there functions in excel that can some of these steps already (like finding slope and intercept of a line)

Thanks

 

[shg]

That's a messy piece of computational geometry.

I implemented it in code some years ago, but it would be hard to extract just the relevant portion. The algorithm is at http://www.box.net/shared/2cdje471if90xz87lhs6

 

[roscoe]

That's pretty much what I was looking for. Thanks!

 

[shg]

You're welcome, good luck.

You'll find it easier to implement if you use a UDT for 2D vectors, and create a vector math library (add, subtract, scalar multiply, dot product, normal, magnitude) to operate on them. Then the code will look pretty much like the algorithm.

 

[roscoe]

More I looked at it the less I liked it

If I only understood C and array-based UDF's, I do soothing like this:
http://alienryderflex.com/polygon_inset/

 

[shg]

The code in VBA is no more complicated:

                For j = 2 To .nV + 1
                    a = scrn2D(j - 1)
                    b = scrn2D(j)
                    c = scrn2D(j + 1)
 
                    d1 = Sv2(b, a)
                    d2 = Sv2(b, c)
 
                    p1 = Sv2(b, Msv2(Dv2(d1, b) / Dv2(d1, d1), d1))
                    p2 = Sv2(b, Msv2(Dv2(d2, b) / Dv2(d2, d2), d2))
 
                    p1p = Msv2(1 + .Margin / Nv2(p1), p1)
                    p2p = Msv2(1 + .Margin / Nv2(p2), p2)
 
                    b = Av2(p1p, Msv2(Det2(MakeMat2(d2, Sv2(p2p, p1p))) / Det2(MakeMat2(d2, d1)), d1))
 
                    ' store the dilated vert
 
                    .MV(j).x = b.x + orgX
                    .MV(j).y = b.y + orgY
                    .MV(j).z = .v(j).z
                Next j

The variable names are from the derivation.

Av2 is vector addition, Sv2 is subtraction, Msv2 is scalar mutiplication, Dv2 is dot product, Nv2 returns a unit normal

 

[roscoe]

Wow...I have to admit, I haven't a CLUE what you just typed. My vector math is way too rusty.

 

[shg]

What's the purpose of this?

What's your experience in integrating VBA code?

 

[roscoe]

The purpose is to take a map border and auto generate an internal "Buffer" border. I was able to get the page I liked to work in VBA...well, kinda. Close enough at this point to know I can get there, just haven't finished yet.

Thanks for the help

 

[shg]

It's been a long time since I revisited this, so I cobbled together a UDF. Here's an example of output:

       --B-- --C--- D -----E------ --F--- G ------H------ --I---
   2                             m   -0.1                       
   3                                                            
   4                  Input Points          Output Points       
   5   Angle Radius        x         y            x         y   
   6       0  1.000          1.000  0.000           0.896 -0.038
   7      45  0.700          0.495  0.495           0.424  0.424
   8      90  1.000          0.000  1.000          -0.009  0.867
   9     135  0.800         -0.566  0.566          -0.469  0.514
  10     180  0.600         -0.600  0.000          -0.501 -0.014
  11     225  1.100         -0.778 -0.778          -0.653 -0.681
  12     270  0.800          0.000 -0.800           0.008 -0.700
  13     315  1.300          0.919 -0.919           0.829 -0.807
  14                                                 #N/A   #N/A
  15                                                 #N/A   #N/A
  16                                                 #N/A   #N/A

The array formula in H6:I16 is

=Dilate(E6:F13, m)

Here's the UDF:

Option Explicit
Public Type uv2
    x           As Double
    y           As Double
End Type
 
Function Dilate(ByVal avdPoly As Variant, m As Double) As Variant
    ' UDF wrapper for adDilate
 
    ' shg 2011
 
    Dim i As Long
    Dim j As Long
 
    Dim ad() As Double
 
    If TypeOf avdPoly Is Range Then avdPoly = avdPoly.Value
    ReDim ad(1 To UBound(avdPoly, 1), 1 To 2)
 
    For i = 1 To UBound(avdPoly, 1)
        ad(i, 1) = avdPoly(i, 1)
        ad(i, 2) = avdPoly(i, 2)
    Next i
 
    adDilate ad, m
    Dilate = ad
End Function
 
Function adDilate(adPol() As Double, m As Double)
    ' shg 2011
 
    ' VBA only
    ' Dilates the vertices of the polygon in P such that
    ' the edges are displaced by m
    Const dBig      As Double = 1.79769313486231E+308
 
    Dim uOrg        As uv2
    Dim dMinX       As Double
    Dim dMaxX       As Double
    Dim dMinY       As Double
    Dim dMaxY       As Double
 
    Dim P()         As uv2      ' Polygon points
    Dim D()         As uv2      ' Direction vector
    Dim T()         As uv2      ' point on edge perp to origin
    Dim S()         As uv2      ' dilation (Scaling) of T about origin
    Dim F()         As uv2      ' see derivation
    Dim O()         As uv2      ' Output points
    Dim nPt         As Long
    Dim i           As Long
 
    nPt = UBound(adPol)
    ReDim Preserve P(0 To nPt + 1)
    ReDim D(1 To nPt + 1)
    ReDim T(1 To nPt + 1)
    ReDim S(1 To nPt + 1)
    ReDim F(1 To nPt)
    ReDim O(1 To nPt)
 
    ' get the center of the bounding box
    dMinX = dBig
    dMaxX = -dBig
    dMinY = dBig
    dMaxY = -dBig
 
    ' copy the points and calculate the extents
    For i = 1 To nPt
        With P(i)
            .x = adPol(i, 1)
            .y = adPol(i, 2)
            If .x < dMinX Then dMinX = .x
            If .x > dMaxX Then dMaxX = .x
            If .y < dMinY Then dMinY = .y
            If .y > dMaxY Then dMaxY = .y
        End With
    Next i
    ' duplicate last point at beginning and
    ' first point at end
    P(0) = P(nPt)
    P(i) = P(1)
    uOrg.x = (dMinX + dMaxX) / 2
    uOrg.y = (dMinY + dMaxY) / 2
 
    ' subtract the origin
    For i = 0 To nPt + 1
        P(i) = Sv2(P(i), uOrg)
    Next i
 
    ' compute direction vectors, perpendiculars, and dilations
    For i = 1 To nPt + 1
        D(i) = Nv2(Sv2(P(i), P(i - 1)))
        T(i) = Sv2(P(i), Msv2(Dv2(P(i), D(i)) / Dv2(D(i), D(i)), D(i)))
        S(i) = Msv2(1 + m / Mv2(T(i)), T(i))
    Next i
 
    ' compute F and new verts
    For i = 1 To nPt
        F(i) = Sv2(D(i), Msv2(Dv2(D(i), D(i + 1)), D(i + 1)))
        O(i) = Av2(S(i), Msv2(Dv2(Sv2(S(i + 1), S(i)), F(i)) / Dv2(D(i), F(i)), D(i)))
        O(i) = Av2(O(i), uOrg)
        ' overwrite the input points
        adPol(i, 1) = O(i).x
        adPol(i, 2) = O(i).y
    Next i
End Function
 
Function Av2(v1 As uv2, v2 As uv2) As uv2
    ' returns v1+v2
    Av2.x = v1.x + v2.x
    Av2.y = v1.y + v2.y
End Function
 
Function Sv2(v1 As uv2, v2 As uv2) As uv2
    ' returns v1-v2
    Sv2.x = v1.x - v2.x
    Sv2.y = v1.y - v2.y
End Function
 
Function Dv2(v1 As uv2, v2 As uv2) As Double
    ' returns v1 dot v2
    Dv2 = v1.x * v2.x + v1.y * v2.y
End Function
 
Function Msv2(S As Double, v As uv2) As uv2
    ' returns s * v2
    Msv2.x = S * v.x
    Msv2.y = S * v.y
End Function
 
Function Mv2(v As uv2) As Double
    ' returns the scalar normal (magnitude) of v
    Mv2 = Sqr(v.x * v.x + v.y * v.y)
End Function
 
Function Nv2(v As uv2) As uv2
    ' returns the a unit vector along v
    Dim Mv As Double
 
    Mv = Mv2(v)
 
    Nv2.x = v.x / Mv
    Nv2.y = v.y / Mv
End Function

I'd like to see your solution when it's done -- it may be a lot more compact.