Leaderboard

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

There is a SysVars for changing decimal separator for Dimensions. DIMDSEP and DIMLUNIT = 2 (Decimal) or it is disabled. But, I believe it's just an override, not sure though. AutoCAD 2022 Help | DIMDSEP (System Variable) | Autodesk Maybe read this... Identify decimal separator via autolisp - AutoLISP, Visual LISP & DCL - AutoCAD Forums

I don't understand this is what I got. It appears to be correct. It matches the co-ordinates you have. anchor bolt plan (1).dwg Anchor bolts copy.xlsx

Change to this will make it more obvious has not worked. Check dwg you may have the colour matching but it is bylayer. (princ "Nothing Selected") (Alert "Nothing Selected")

Friends, This is an update: LAMBDA function for convert decimal value to imperial architect format, with optional argument conversion from factor [cFact], similar format from previous post for consistency with a fixed 1/64 round-off. UDF/ Excel Name: toimpa() =LAMBDA(decimal,[cFact], LET(si,IF(LEFT(decimal,1)="-",-1,1), rd,1/64, cf,IF(ISOMITTED(cFact),1,cFact), IF(NOT(ISNUMBER(decimal)),"n/a", IF(OR(MROUND(decimal/cf,si*rd)>=12,MROUND(decimal/cf,si*rd)<=-12), ROUNDDOWN(MROUND(decimal/cf,si*rd)/12,0)&"'-"&TEXT(MOD(MROUND(ABS(decimal/cf),rd),12),"0 #/####")&"""", TEXT(MROUND(decimal/cf,si*rd),"# #/####")&"""")) ) ) In addition, here are some test/experiment functions, these will work with imperial array: Note that these functions use todec() and toimpa() functions from above and in previous post. UDF/Excel Name: sumtoimpa() Similar to Excel SUM() function =LAMBDA(imperials,toimpa(SUM(MAP(imperials,todec)))) UDF/Excel Name: sumtodec() - with optional argument convert to factor [cFact] Similar to Excel SUM() function =LAMBDA(imperials,[cFact],(SUM(MAP(imperials,todec))*IF(ISOMITTED(cFact),1,cFact))) UDF/Excel Name: averageimpa() Similar to Excel AVERAGE() function =LAMBDA(imperials,toimpa(AVERAGE(MAP(imperials,todec)))) UDF/Excel Name: minimpa() Similar to Excel MIN() function =LAMBDA(imperials,toimpa(MIN(MAP(imperials,todec)))) UDF/Excel Name: maximpa() Similar to Excel MAX() function =LAMBDA(imperials,toimpa(MAX(MAP(imperials,todec)))) UDF/Excel Name: rangeimpa() Similar to Excel (MAX() - MIN()) functions =LAMBDA(imperials,toimpa(MAX(MAP(imperials,todec))-MIN(MAP(imperials,todec)))) UDF/Excel Name: largeimpa() Similar to Excel LARGE() function =LAMBDA(imperials,rank,toimpa(LARGE(MAP(imperials,todec),rank))) UDF/Excel Name: smallimpa() Similar to Excel SMALL() function =LAMBDA(imperials,rank,toimpa(SMALL(MAP(imperials,todec),rank))) Let me know if there any problem. Happy holidays! Phh Some test

LAMBDA function for convert Imperial feet-inches (in various formats) to decimal value, with optional argument conversion factor [cFact]. or define "Excel Name" to hold conversion factor such as: in=1 (default inch if not specify) ft=1/12 yd=1/36 mi=1/63360 (mile) mm=25.4 cm=2.54 m=0.0254 ... ... ... UDF/ Excel Name: todec() =LAMBDA(imperial,[cFact], LET(si,IF(LEFT(imperial,1)="-",-1,1), ft,IFERROR(ABS(VALUE(LEFT(imperial,(FIND("'",imperial)-1)))),0), in,TRIM(SUBSTITUTE(SUBSTITUTE(IFERROR(RIGHT(imperial,LEN(imperial)-FIND("'",imperial)),imperial),"-",""),"""","")), si*(ft*12+VALUE(IF(ISERR(AND(FIND(" ",in),FIND("/",in))),IFERROR(VALUE("0 "&in),in),in)))/IF(ISOMITTED(cFact),1,1/cFact)) ) Some test Phh

Tweak version of lambda function from previous post with added flexibility of conversion and simple range calculations if you know your conversion factor and round-off number of your choice. Lambda function for convert decimal value to imperial feet-inches fraction, text format [#'-# #/#"] Name: testfunc (or some meaningful name) usage: testfunc(varNum, cFact, rdOff) Parameters notes: varNum = Required, decimal number value to be converted (ex: value in a cell A1, B10, C15, etc.. or range A:A, or multiple ranges (A:A,B:B) - note of enclosed parenthesis and ranges separated by comma) cFact = Required, conversion factor from value (1 = inch, 1/12 = feet, 1/36 = yard, 25.4 = millimeter, 2.54 = centimeter, 0.0254 = meter, etc...) Or define Excel Name to hold conversion factor value, ex: in=1 ft=1/12 yd=1/36 mm=25.4 cm=2.54 m=0.0254 ... ... ... rdOff = Required, rounded to the desired multiple (ex: 1, 1/2, 1/4, 1/8, 1/16, 1/64, 1/4096, etc...) =LAMBDA(varNum, cFact, rdOff, IF(NOT(ISNUMBER(SUM(varNum))),"n/a", IF(OR(MROUND(SUM(varNum)/cFact,SIGN(SUM(varNum))*rdOff)>=12,MROUND(SUM(varNum)/cFact,SIGN(SUM(varNum))*rdOff)<=-12), ROUNDDOWN(MROUND(SUM(varNum)/cFact,SIGN(SUM(varNum))*rdOff)/12,0)&"'-"&TEXT(MOD(MROUND(ABS(SUM(varNum)/cFact),rdOff),12),"0 #/####")&"""", TEXT(MROUND(SUM(varNum)/cFact,SIGN(SUM(varNum))*rdOff),"# #/####")&"""")) ) Phh

Excel LAMBDA Function In Excel, Office 365 or recent version of Excel if LAMBDA function available, you can take advance of looooong calculation formula by using LAMBDA function! Per MS: Define Name: give_a_meaningful_name Clear "Refer to" box: And paste your calculation formula to create custom user define function. In this case, for example: I create name "str2impa" and replace "A1" to "in" which is the parameter. =LAMBDA(in, IF(NOT(ISNUMBER(in)),"n/a", IF(OR(MROUND(in,SIGN(in)*1/64)>=12,MROUND(in,SIGN(in)*1/64)<=-12), ROUNDDOWN(MROUND(in,SIGN(in)*1/64)/12,0)&"'-"&TEXT(MOD(MROUND(ABS(in),1/64),12),"0 #/##")&"""", TEXT(MROUND(in,SIGN(in)*1/64),"# #/##")&"""")) ) Phh

There is something I am still learning, some minor issue with rounding when combine with text formatting, and fact that I work it out but still test and debugging! Let try this sequence with round-off 1/64 for example: From decimal (inches) to Imperial architectural format round-off 1/64 Cell A1 11.9 = 11 29/32" [Correct] 11.99 = 11 63/64" [Correct] 11.999 = 12" [Correct but some what!] I expect the format would display 1'-0" but end up 12" ?!?! what I learn is that on the 1st line of the formula, the second IF() statement the value of A1 not the same value of A1 on 2nd and 3rd lines because of MROUND()! To correct this issue, the value of A1 should be exact the same throughout! Here the update version I am currently testing... but not final, please bear with me for my hiccup! =IF(OR(MROUND(A1,SIGN(A1)*1/64)>=12,MROUND(A1,SIGN(A1)*1/64)<=-12), ROUNDDOWN(MROUND(A1,SIGN(A1)*1/64)/12,0)&"'-"&TEXT(MOD(MROUND(ABS(A1),1/64),12),"0 #/##")&"""", TEXT(MROUND(A1,SIGN(A1)*1/64),"# #/##")&"""") Please note that I sacrifice first IF() because it is too long, move SIGN() inside MROUND() and remove ABS(), shorten format numerator (the denominator number digits are importance and must match with number of digits of rounding, ex. 1/2, 1/8 -> #/# ; 1/16, 1/32, 1/64 -> #/## ; 1/4096 -> #/####, etc.) Will keep you post, and sorry for my bad! 11/5/2022 Update formula to resolve rounding & text formatting issue (see post above) Rearrange MROUND() and SIGN() for consistent and easy to read Phh

Good stuff! I the approach when importing from excel to cad using C++. 1, read the number raw value from excel. 2, read the number format ID; 3, read the format, example #,##0.00, #.##0.00 or "\'" etc. 4, translate using cad functions, LUPREC, LUNITS, acutCvUnit etc. For tables, I use AcValue and a format string %lu2%pr2 if I see #,##0.00 There’s a thing for the thousand’s separator, %th I think Not sure if that stuff in VBA

Update formula (all) 2nd lines (see post above) to resolve rounding and text formatting issue, For example: 119.999 when convert and round-off should display 10'-0" instead of 9'-12" Update MROUND() using with SIGN() to correct issue with negative number My apology! Phh

Just plain Excel formula for quick convert from decimal to Imperial feet-inches, when I do BOM, schedule for my drawings, or share workbook to ppl don't use VBA (like my boss and my co-worker, Mac users) Update formula to resolve rounding & text formatting issue (11/5/2022), see post below From decimal (inches) to Imperial architectural format round-off 1/64 =IF(NOT(ISNUMBER(A1)),"n/a", IF(OR(MROUND(A1,SIGN(A1)*1/64)>=12,MROUND(A1,SIGN(A1)*1/64)<=-12), ROUNDDOWN(MROUND(A1,SIGN(A1)*1/64)/12,0)&"'-"&TEXT(MOD(MROUND(ABS(A1),1/64),12),"0 #/##")&"""", TEXT(MROUND(A1,SIGN(A1)*1/64),"# #/##")&"""")) From decimal (inches) to Imperial engineering format round-off 1/64 =IF(NOT(ISNUMBER(A1)),"n/a", IF(OR(MROUND(A1,SIGN(A1)*1/64)>=12,MROUND(A1,SIGN(A1)*1/64)<=-12), ROUNDDOWN(MROUND(A1,SIGN(A1)*1/64)/12,0)&"'-"&MOD(MROUND(ABS(A1),1/64),12)&"""", MROUND(A1,SIGN(A1)*1/64)&"""")) From decimal (feet) to Imperial architectural format round-off 1/64 =IF(NOT(ISNUMBER(A1)),"n/a", IF(OR(MROUND(A1*12,SIGN(A1)*1/64)>=12,MROUND(A1*12,SIGN(A1)*1/64)<=-12), ROUNDDOWN(MROUND(A1*12,SIGN(A1)*1/64)/12,0)&"'-"&TEXT(MOD(MROUND(ABS(A1*12),1/64),12),"0 #/##")&"""", TEXT(MROUND(A1*12,SIGN(A1)*1/64),"# #/##")&"""")) From decimal (feet) to Imperial engineering format round-off 1/64 =IF(NOT(ISNUMBER(A1)),"n/a", IF(OR(MROUND(A1*12,SIGN(A1)*1/64)>=12,MROUND(A1*12,SIGN(A1)*1/64)<=-12), ROUNDDOWN(MROUND(A1*12,SIGN(A1)*1/64)/12,0)&"'-"&MOD(MROUND(ABS(A1*12),1/64),12)&"""", MROUND(A1*12,SIGN(A1)*1/64)&"""")) Phh

Update functions to work with negative feet-inches Remove optional "argument_format" Phh ''################################################################# ''## 7 Functions to deal with feet-inches format in Excel ## ''## in form of [#'-#"] or [#'-# #/##"] or [#'-#.##"] ## ''## By Phh, 2010, last update 6/26/2022 ## ''## Functions update to work with negative feet-inches ## ''################################################################# ''## 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) As Double Dim startPos, ftPos, frPos, signofNum As Integer Dim rdLen As Double strX = Trim$(strX) If Left$(strX, 1) = "-" Then signofNum = -1 Else signofNum = 1 End If strX = Replace(Replace(strX, """", ""), "-", "") startPos = 1 ftPos = InStr(startPos, strX, "'") frPos = InStr(startPos, strX, "/") If ftPos = 0 And frPos = 0 Then todec = Val(strX) * signofNum Exit Function End If If ftPos = 0 And frPos > 0 Then todec = frac2num(strX) * signofNum Exit Function End If rdLen = CDbl(Left$(strX, ftPos - 1)) * 12 If frPos = 0 Then rdLen = rdLen + (Val(Mid$(strX, ftPos + 1, Len(strX)))) todec = rdLen * signofNum Exit Function End If rdLen = rdLen + frac2num(Mid$(strX, ftPos + 1, Len(strX))) todec = rdLen * signofNum End Function Public Function toimpe(rawLen As Double, Optional argRd As Variant = 16) As String Dim rdLen As Double, argRdNum As Double If argRd >= 1 Then argRdNum = 1 / Fix(argRd) rdLen = Excel.WorksheetFunction.Round(rawLen / argRdNum, 0) * argRdNum ElseIf argRd < 1 And argRd > 0 Then argRdNum = argRd rdLen = Excel.WorksheetFunction.Round(rawLen / argRdNum, 0) * argRdNum Else rdLen = rawLen End If If Abs(Excel.WorksheetFunction.Round(rawLen / argRdNum, 0)) < Abs(argRdNum) Then toimpe = "0""" Exit Function End If If rdLen <= -12 Or rdLen >= 12 Then toimpe = (Fix(rdLen / 12)) & "'-" & Abs(rdLen - (12 * Fix(rdLen / 12))) & """" ElseIf rdLen < 12 And rdLen > -12 Then toimpe = rdLen & """" End If End Function Public Function toimpa(rawLen As Double, Optional argRd As Variant = 16) As String Dim rdLen As Double, argRdNum As Double If argRd >= 1 Then argRdNum = 1 / Fix(argRd) rdLen = Excel.WorksheetFunction.Round(rawLen / argRdNum, 0) * argRdNum ElseIf argRd < 1 And argRd > 0 Then argRdNum = argRd rdLen = Excel.WorksheetFunction.Round(rawLen / argRdNum, 0) * argRdNum Else rdLen = rawLen End If If Abs(Excel.WorksheetFunction.Round(rawLen / argRdNum, 0)) < Abs(argRdNum) Then toimpa = "0""" Exit Function End If If rdLen <= -12 Or rdLen >= 12 Then toimpa = (Fix(rdLen / 12)) & "'-" & Excel.WorksheetFunction.Text(Abs(rdLen - (12 * Fix(rdLen / 12))), "0 ##/####") & """" ElseIf rdLen < 12 And rdLen > -12 Then If (rdLen - Fix(rdLen)) = 0 Then toimpa = rdLen & """" Else toimpa = Excel.WorksheetFunction.Text(rdLen, "# ###/###") & """" End If End If 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 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-off to 1/512" as default, change if required! ## ''####################################################################### argRdNum = (1 / 512) sumArray = Excel.WorksheetFunction.Round(sumArray / argRdNum, 0) * argRdNum If sumArray <= -12 Or sumArray >= 12 Then sumtoimpe = (Fix(sumArray / 12)) & "'-" & Abs(sumArray - (12 * Fix(sumArray / 12))) & """" ElseIf sumArray < 12 And sumArray > -12 Then sumtoimpe = sumArray & """" End If 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-off to 1/512" as default, change if required! ## ''####################################################################### argRdNum = (1 / 512) sumArray = Excel.WorksheetFunction.Round(sumArray / argRdNum, 0) * argRdNum If sumArray <= -12 Or sumArray >= 12 Then sumtoimpa = (Fix(sumArray / 12)) & "'-" & Excel.WorksheetFunction.Text(Abs(sumArray - (12 * Fix(sumArray / 12))), "0 ##/####") & """" ElseIf sumArray < 12 And sumArray > -12 Then If (sumArray - Fix(sumArray)) = 0 Then sumtoimpa = sumArray & """" Else sumtoimpa = Excel.WorksheetFunction.Text(sumArray, "# ###/###") & """" End If End If 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 = (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