Function SecProp(xy_range As Variant, Optional Out As Long) As Variant
Dim XYcells As Variant
Dim N As Long, NumX As Long
Dim X1 As Double, X2 As Double, Y1 As Double, Y2 As Double, XD As Double, YD As Double, YSum As Double
Dim PropArray(1 To 14, 1 To 1) As Double
Dim Area As Double, Ax As Double, Ay As Double, IXO As Double, IYO As Double, IXYO As Double, Xbar As Double, Ybar As Double
Dim IXC As Double, IYC As Double, IXYC As Double, IU As Double, IV As Double, Theta As Double, A As Double
Dim IXYORel As Double, IXYCRel As Double
Const RelTol As Double = 0.000000000001
xy_range = xy_range.value2 ' Convert the data range to an array. Access values using X = xy_range(row number, column number)
NumX = UBound(xy_range)
'Iterate index from 1 to 1 less than number of members
For N = 1 To NumX - 1
' Get X and Y values for each end of each segment
X1 = xy_range(N, 1)
X2 = xy_range((N + 1), 1)
Y1 = xy_range(N, 2)
Y2 = xy_range((N + 1), 2)
XD = X2 - X1
YD = Y2 - Y1
YSum = Y2 + Y1
' Calculate section properties
Area = Area + XD * YSum / 2
Ax = Ax + XD / 2 * (Y1 ^ 2 + YD * (Y1 + YD / 3))
Ay = Ay - YD / 2 * (X1 ^ 2 + XD * (X1 + XD / 3))
IXO = IXO + XD * (Y1 ^ 3 / 3 + YD ^ 3 / 36 + YD / 2 * (Y1 + YD / 3) ^ 2)
IYO = IYO - YD * (X1 ^ 3 / 3 + XD ^ 3 / 36 + XD / 2 * (X1 + XD / 3) ^ 2)
IXYO = IXYO - X1 ^ 2 * YD * (Y1 + Y2) / 4 - XD ^ 2 * YD ^ 2 / 72 - XD * YD * (2 * X1 + X2) * (2 * Y2 + Y1) / 18
Next N
' The remaining section properties are found from the 6 calculated above
Xbar = Ay / Area
Ybar = Ax / Area
IXC = IXO - Area * Ybar ^ 2
IYC = IYO - Area * Xbar ^ 2
IXYC = IXYO - Area * Xbar * Ybar
' Check IXYO if IXC and IYC are very nearly equal
If IXC > IYC Then IXYORel = IXYO / IXC Else IXYORel = IXYO / IYC
If Abs(IXYORel) < RelTol Then IXYO = 0
A = ((IXC - IYC) * (IXC - IYC) / 4 + IXYC ^ 2) ^ 0.5
IU = (IXC + IYC) / 2 + A
IV = (IXC + IYC) / 2 - A
' Find Theta with check if IXC and IYC are almost equal
If IXC > IYC Then IXYCRel = IXYC / IXC Else IXYCRel = IXYC / IYC
If Abs(IXYCRel) > RelTol Then
Theta = 0.5 * (Atn2((IXC - IYC), 2 * IXYC))
Else
IXYC = 0
Theta = 0
End If
Theta = Theta * 180 / dPi
' Copy section properties to the PropArray array
PropArray(1, 1) = Area
PropArray(2, 1) = Ax
PropArray(3, 1) = Ay
PropArray(4, 1) = IXO
PropArray(5, 1) = IYO
PropArray(6, 1) = IXYO
PropArray(7, 1) = Xbar
PropArray(8, 1) = Ybar
PropArray(9, 1) = IXC
PropArray(10, 1) = IYC
PropArray(11, 1) = IXYC
PropArray(12, 1) = IU
PropArray(13, 1) = IV
PropArray(14, 1) = Theta
' Return the whole array, or if Out is not equal to zero, return one section property value
If Out = 0 Then
SecProp = PropArray
ElseIf Out > 0 Then
SecProp = PropArray(Out, 1)
End If
End Function