Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 02/23/2022 in all areas

  1. Hello everyone, Just a collection of functions that I learn and post here, hope they are usefull to you just as I do in my day to day job. Phh ''################################################################# ''## Functions to deal with feet-inches format ## ''## in a form of [#'-#"] or [#'-# #/##"] or [#'-#.##"] ## ''## By Phh, 2010, last update 2021 ## ''################################################################# ''## todec() Convert to decimal ## ''## toimpe() Convert to imperial, engineering format ## ''## with optional precision argument, default 1/16" ## ''## toimpa() Convert to imperial, architectural format ## ''## with optional precision argument, default 1/16" ## ''## sumtodec() Similar to SUM function, decimal format ## ''## sumtoimpe() Similar to SUM function, engineering format ## ''## sumtoimpa() Similar to SUM function, architectural format ## ''## frac2num() Sub function, convert fraction to decimal ## ''################################################################# Option Explicit Public Function todec(strX As String, Optional argDivBy As Double) As Double Dim startPos As Integer, ftPos As Integer, frPos As Integer Dim rdLen, argDivNum As Double If argDivBy > 0 Then argDivNum = argDivBy Else argDivNum = 1 End If strX = Replace(Replace(strX, """", ""), "-", "") strX = WorksheetFunction.Trim(strX) startPos = 1 ftPos = InStr(startPos, strX, "'") frPos = InStr(startPos, strX, "/") If ftPos = 0 And frPos = 0 Then todec = (Val(strX) / argDivNum) Exit Function End If If ftPos = 0 And frPos > 0 Then todec = (frac2num(strX) / argDivNum) Exit Function End If rdLen = CDbl(Left(strX, ftPos - 1)) * 12 If frPos = 0 Then rdLen = rdLen + (Abs(Val(Mid(strX, ftPos + 1, Len(strX))))) todec = (rdLen / argDivNum) Exit Function End If rdLen = rdLen + frac2num(Mid(strX, ftPos + 1, Len(strX))) todec = (rdLen / argDivNum) End Function Public Function sumtodec(ParamArray Xrange() As Variant) As Double Dim sumArray As Double Dim theVal As Variant Dim I As Integer For I = LBound(Xrange) To UBound(Xrange) If TypeOf Xrange(I) Is Range Then For Each theVal In Xrange(I) sumArray = sumArray + todec(CStr(theVal)) Next theVal Else sumArray = sumArray + CDbl(Xrange(I)) End If Next sumtodec = sumArray End Function Public Function toimpe(aLen As Double, Optional argRd As Variant = 16) As String Dim rdLen As Double, argRdNum As Double If argRd >= 1 Then argRdNum = 1 / Fix(argRd) ElseIf argRd < 1 And argRd > 0 Then argRdNum = argRd ElseIf argRd = 0 Then toimpe = (Fix(aLen / 12)) & "'-" & (aLen - (12 * Fix(aLen / 12))) & """" Exit Function End If rdLen = excel.WorksheetFunction.Round(aLen / argRdNum, 0) * argRdNum toimpe = (Fix(rdLen / 12)) & "'-" & (rdLen - (12 * Fix(rdLen / 12))) & """" End Function Public Function toimpa(aLen As Double, Optional argRd As Variant = 16) As String Dim rdLen As Double, argRdNum As Double If argRd >= 1 Then argRdNum = 1 / Fix(argRd) ElseIf argRd < 1 And argRd > 0 Then argRdNum = argRd ElseIf argRd = 0 Then toimpa = (Fix(aLen / 12)) & "'-" & excel.WorksheetFunction.Text((aLen - (12 * Fix(aLen / 12))), "0 ##/####") & """" Exit Function End If rdLen = excel.WorksheetFunction.Round(aLen / argRdNum, 0) * argRdNum toimpa = (Fix(rdLen / 12)) & "'-" & excel.WorksheetFunction.Text((rdLen - (12 * Fix(rdLen / 12))), "0 ##/####") & """" End Function Public Function sumtoimpe(ParamArray Xrange() As Variant) As String Dim sumArray As Double, argRdNum As Double Dim theVal As Variant Dim I As Integer For I = LBound(Xrange) To UBound(Xrange) If TypeOf Xrange(I) Is Range Then For Each theVal In Xrange(I) sumArray = sumArray + todec(CStr(theVal)) Next theVal Else sumArray = sumArray + CDbl(Xrange(I)) End If Next 'Set precision round of to 1/256" as default, change if required! argRdNum = (1 / 256) sumArray = excel.WorksheetFunction.Round(sumArray / argRdNum, 0) * argRdNum sumtoimpe = (Fix(sumArray / 12)) & "'-" & (sumArray - (12 * Fix(sumArray / 12))) & """" End Function Public Function sumtoimpa(ParamArray Xrange() As Variant) As String Dim sumArray As Double, argRdNum As Double Dim theVal As Variant Dim I As Integer For I = LBound(Xrange) To UBound(Xrange) If TypeOf Xrange(I) Is Range Then For Each theVal In Xrange(I) sumArray = sumArray + todec(CStr(theVal)) Next theVal Else sumArray = sumArray + CDbl(Xrange(I)) End If Next 'Set precision round of to 1/256" as default, change if required! argRdNum = (1 / 256) sumArray = excel.WorksheetFunction.Round(sumArray / argRdNum, 0) * argRdNum sumtoimpa = (Fix(sumArray / 12)) & "'-" & excel.WorksheetFunction.Text((sumArray - (12 * Fix(sumArray / 12))), "0 ##/####") & """" End Function Function frac2num(ByVal X As String) As Double Dim P As Integer Dim N As Double, Num As Double, Den As Double X = Trim$(X) P = InStr(X, "/") If P = 0 Then N = Val(X) Else Den = Val(Mid$(X, P + 1)) If Den = 0 Then Error 11 X = Trim$(Left$(X, P - 1)) P = InStr(X, " ") If P = 0 Then Num = Val(X) Else Num = Val(Mid$(X, P + 1)) N = Val(Left$(X, P - 1)) End If End If If Den <> 0 Then N = N + Num / Den End If frac2num = N End Function
    1 point
  2. Unfortunately, the person that should have your back is your P-F instructor. Instructors should be available to answer student questions regarding the assigned projects. They should have also provided a clear explanation of how to interpolate contour points between spot elevations in the project instructions. P-F is not known for providing helpful and timely assistance. They are, however, very good at separating a student from his/her money though. I hold them in the lowest regard. Seems they have not changed their ways even after all this time. Too bad.
    1 point
  3. So, now I get mushy. Thank you so much for all of your responses. I was feeling hopeless when I closed up yesterday. When I received my update on this page and saw how many of you who had my back wanting to help. I was no longer hopeless and was instead filled with hope Thank you so much
    1 point
  4. Hoping this helps straighten you out re: interpolation. (Project 6 - 562 Ocean Avenue) The mathematical interpolation of contours goes something like this. Let's say we have two spot elevations A & B. A = 32.7 and B = 54.0. The distance between A & B = 50 feet. We want to know where our 40 foot contour would fall between spot elevations A & B. First obtain the total elevation difference. This is done by subtracting A from B. 54.0 minus 32.7 = 21.3. Next we want the difference in elevation between our 40 ft. contour interval and the nearest spot elevation which in this case is A or 32.7. That works out to be 7.3. Now we need to calculate the distance (let's call this "d") we need to go from spot elevation A to our 40 foot contour. That takes the form of: d/7.3=50/21.3 or d=7.3*50/21.3 = 7.3*2.347 = 17.13 or the distance, in decimal feet, to our 40 foot contour. Make any sense to you?
    1 point
  5. Here's a few variations the last one jumps half each time. *Boards_1, Wide boards 0, 0,0, 0,150 90, 0,0,300,900,150,-450 90, 500,150,300,900,150,-450 *Boards_2, Wide boards 0, 0,0, 0,150 90, 0,0,600,1800,150,-450 90, 100,150,600,1800,150,-450 90, 600,300,600,1800,150,-450 90, 250,450,600,1800,150,-450 *Boards_3, Wide boards 0, 0,0, 0,150 90, 0,0, 150,450, 150,-450 *Boards_4, Wide boards 0, 0,0, 0,150 90, 0,0, 150,900, 150,-150
    1 point
×
×
  • Create New...