Cosmos75

06-28-2004, 11:37 AM

I am having some trouble getting code to work.

I have the x & y coordinates of locations and the elevations for the starting and ending coordinates. The assumption I have is that the elevation change from the first point to the last point is constant (i.e. changes equally over equal distance in a straight line).

But the coordinates I have are not in a straight line.

x, y, Elevation (ft)

0 0 0

2 2

5 2

3 9

10 10 100

The elevations should be

x, y, Elevation (ft)

0 0 0

2 2 20

5 2 35

3 9 60

10 10 100

e.g.

y = f (x) = 10x

- This is the equation for the line from the starting-ending points

To find the elevation for (5,2) I need to find the equation for a line perpendicular to my starting-ending line that intersects (5,2). All points along this line will have the same elevation (or any points along a line perpendicular to the starting-ending line for that matter).

An equation for a straight line takes the form of

y = Ax + C

where,

A = Slope of line

C = Constant (i.e. where line intersects y-axis when x = 0)

A line perpendicular to this will have this form

yp = -x/A + Cp

where,

yp = Perpendicular function

Cp = Constant (may or may not be equal to C)

Using the intersection point between these two lines and the equation for my starting-ending line, I can figure out the elevation for (5,2).

On top of that I have gaps between my data

x, y, Elevation (ft)

0, 0, 0

2, 2,

5, 2,

3, 9,

10, 10, 100

11, 12,

12, 15,

15, 16,

20, 20, 220

You may have noticed that (20,20) has an elevation of 220 not 200. In this case the starting point is (10,10) and the ending point is (20,20).

:wot

So I have created a function that uses UDT (User Defined Type) to calculate this for me.

Public Type udtXYFunction

xySlope As Double

xyConstant As Double

xyY As Double

xyX As Double

End Type

Sub funcLER()

Dim LastRow, StartRow, EndRow As Integer

Dim CurrentElevation, StartElevation, LastElevation, _

EndElevation, RatioElevation As Double

Dim coorX1, coorX2, coorY1, coorY2 As Double

Dim TotalDistance, RatioDistance As Double

Dim intersectX As Double

Dim Slope As Double

Dim Constant As Double

Dim SlopePerpendicular, ConstantPerpendicular, _

PerpendicularX, PerpendicularY As Double

'Find last row with data

LastRow = Cells(65536, 1).End(xlUp).Row

'Starting Elevation

StartElevation = Cells(1, 3).Value

'Ending Elevation

LastElevation = Cells(LastRow, 3).Value

StartRow = 1

For i = 2 To LastRow

CurrentElevation = Cells(i, 3).Value

If Cells(i, 3).Value <> 0 Then

EndElevation = CurrentElevation

EndRow = Cells(i, 3).Row

Cells(i, 3).Font.Bold = True

If EndRow - StartRow = 1 Then

StartRow = EndRow

StartElevation = EndElevation

Else

For h = StartRow + 1 To EndRow - 1

'Elevation Difference

ElevationDiff = EndElevation - StartElevation

'Total Length

TotalDistance = CalcDistance(Cells(StartRow, 1), Cells(i, 1), Cells(StartRow, 2), Cells(i, 2))

'Slope & Constant for Start-to-End function, i.e. y(x)

Slope = CalcXYFunction(Cells(StartRow, 1), Cells(EndRow, 1), Cells(StartRow, 2), Cells(EndRow, 2)).xySlope

Constant = CalcXYFunction(Cells(StartRow, 1), Cells(EndRow, 1), Cells(StartRow, 2), Cells(EndRow, 2)).xyConstant

'Slope for a perpendicular line, i.e. y2(x)

SlopePerpendicular = -1 / Slope

ConstantPerpendiclar = Cells(h, 2) + (SlopePerpendicular * Cells(h, 1))

'Find intersection point

intersectX = (ConstantPerpendicular - Constant) / (Slope + SlopePerpendicular)

intersectY = XYFunction(0, intersectX, Slope, Constant).xyY

Next h

StartRow = EndRow

StartElevation = EndElevation

End If

End If

Next i

End Sub

Function CalcDistance(X1 As Double, X2 As Double, Y1 As Double, Y2 As Double) As Double

Dim B, C As Double

B = (X1 - X2) ^ 2

C = (Y1 - Y2) ^ 2

CalcDistance = Sqr(B + C)

End Function

Function CalcXYFunction(X1 As Double, X2 As Double, Y1 As Double, Y2 As Double) As udtXYFunction

CalcXYFunction.xySlope = (Y2 - Y1) / (X2 - X1)

CalcXYFunction.xyConstant = Y1 - (CalcXYFunction.xySlope * X1)

End Function

Function XYFunction(Y As Double, X As Double, Slope As Double, Constant As Double) As udtXYFunction

XYFunction.xyY = (Slope * X) + Constant

XYFunction.xyX = (Y - Constant) / Slope

End Function

I keep running into a problem using the function XYFunction when the function inputs are calculated using other functions.

When I do Dim interceptY as Double, I get this error.

?Compile Error:

ByRef argument type mismatch?

:confused:

When I don?t Dim interceptY as Double, I get this error.

?Compile Error:

Only user-defined types defined in public object modules can be coerced to or from a variant or passed to late-bound functions.?

:bawl

The line that is causing me problems is bolded in red.

What am I doing wrong? I am using Excel 2000.

:help

Thank you in advance to anyone who even bothers to read through all of this!

:)

I have the x & y coordinates of locations and the elevations for the starting and ending coordinates. The assumption I have is that the elevation change from the first point to the last point is constant (i.e. changes equally over equal distance in a straight line).

But the coordinates I have are not in a straight line.

x, y, Elevation (ft)

0 0 0

2 2

5 2

3 9

10 10 100

The elevations should be

x, y, Elevation (ft)

0 0 0

2 2 20

5 2 35

3 9 60

10 10 100

e.g.

y = f (x) = 10x

- This is the equation for the line from the starting-ending points

To find the elevation for (5,2) I need to find the equation for a line perpendicular to my starting-ending line that intersects (5,2). All points along this line will have the same elevation (or any points along a line perpendicular to the starting-ending line for that matter).

An equation for a straight line takes the form of

y = Ax + C

where,

A = Slope of line

C = Constant (i.e. where line intersects y-axis when x = 0)

A line perpendicular to this will have this form

yp = -x/A + Cp

where,

yp = Perpendicular function

Cp = Constant (may or may not be equal to C)

Using the intersection point between these two lines and the equation for my starting-ending line, I can figure out the elevation for (5,2).

On top of that I have gaps between my data

x, y, Elevation (ft)

0, 0, 0

2, 2,

5, 2,

3, 9,

10, 10, 100

11, 12,

12, 15,

15, 16,

20, 20, 220

You may have noticed that (20,20) has an elevation of 220 not 200. In this case the starting point is (10,10) and the ending point is (20,20).

:wot

So I have created a function that uses UDT (User Defined Type) to calculate this for me.

Public Type udtXYFunction

xySlope As Double

xyConstant As Double

xyY As Double

xyX As Double

End Type

Sub funcLER()

Dim LastRow, StartRow, EndRow As Integer

Dim CurrentElevation, StartElevation, LastElevation, _

EndElevation, RatioElevation As Double

Dim coorX1, coorX2, coorY1, coorY2 As Double

Dim TotalDistance, RatioDistance As Double

Dim intersectX As Double

Dim Slope As Double

Dim Constant As Double

Dim SlopePerpendicular, ConstantPerpendicular, _

PerpendicularX, PerpendicularY As Double

'Find last row with data

LastRow = Cells(65536, 1).End(xlUp).Row

'Starting Elevation

StartElevation = Cells(1, 3).Value

'Ending Elevation

LastElevation = Cells(LastRow, 3).Value

StartRow = 1

For i = 2 To LastRow

CurrentElevation = Cells(i, 3).Value

If Cells(i, 3).Value <> 0 Then

EndElevation = CurrentElevation

EndRow = Cells(i, 3).Row

Cells(i, 3).Font.Bold = True

If EndRow - StartRow = 1 Then

StartRow = EndRow

StartElevation = EndElevation

Else

For h = StartRow + 1 To EndRow - 1

'Elevation Difference

ElevationDiff = EndElevation - StartElevation

'Total Length

TotalDistance = CalcDistance(Cells(StartRow, 1), Cells(i, 1), Cells(StartRow, 2), Cells(i, 2))

'Slope & Constant for Start-to-End function, i.e. y(x)

Slope = CalcXYFunction(Cells(StartRow, 1), Cells(EndRow, 1), Cells(StartRow, 2), Cells(EndRow, 2)).xySlope

Constant = CalcXYFunction(Cells(StartRow, 1), Cells(EndRow, 1), Cells(StartRow, 2), Cells(EndRow, 2)).xyConstant

'Slope for a perpendicular line, i.e. y2(x)

SlopePerpendicular = -1 / Slope

ConstantPerpendiclar = Cells(h, 2) + (SlopePerpendicular * Cells(h, 1))

'Find intersection point

intersectX = (ConstantPerpendicular - Constant) / (Slope + SlopePerpendicular)

intersectY = XYFunction(0, intersectX, Slope, Constant).xyY

Next h

StartRow = EndRow

StartElevation = EndElevation

End If

End If

Next i

End Sub

Function CalcDistance(X1 As Double, X2 As Double, Y1 As Double, Y2 As Double) As Double

Dim B, C As Double

B = (X1 - X2) ^ 2

C = (Y1 - Y2) ^ 2

CalcDistance = Sqr(B + C)

End Function

Function CalcXYFunction(X1 As Double, X2 As Double, Y1 As Double, Y2 As Double) As udtXYFunction

CalcXYFunction.xySlope = (Y2 - Y1) / (X2 - X1)

CalcXYFunction.xyConstant = Y1 - (CalcXYFunction.xySlope * X1)

End Function

Function XYFunction(Y As Double, X As Double, Slope As Double, Constant As Double) As udtXYFunction

XYFunction.xyY = (Slope * X) + Constant

XYFunction.xyX = (Y - Constant) / Slope

End Function

I keep running into a problem using the function XYFunction when the function inputs are calculated using other functions.

When I do Dim interceptY as Double, I get this error.

?Compile Error:

ByRef argument type mismatch?

:confused:

When I don?t Dim interceptY as Double, I get this error.

?Compile Error:

Only user-defined types defined in public object modules can be coerced to or from a variant or passed to late-bound functions.?

:bawl

The line that is causing me problems is bolded in red.

What am I doing wrong? I am using Excel 2000.

:help

Thank you in advance to anyone who even bothers to read through all of this!

:)