Julian Carr Posted October 26, 2020 Share Posted October 26, 2020 Anyone have a routine for converting decimal inches into fractions, irrespective of the document unit settings? For example: 1.375 -> 1 3/8" 1.188 -> 1 3/16" 1.75 -> 1 3/4" 1.5 -> 1 1/2" 4.25 -> 4 1/4" Thanks! Quote Link to comment
Pat Stanford Posted October 26, 2020 Share Posted October 26, 2020 Here is the basic algorithm. It needs some work to simplify the fractional part (0.5 shows as 4/8 instead of 1/2), and to round up to the next whole number if the fraction is equal to 1. Procedure Test; Const Base=8; Var Original, DecPart: Real; IntPart, FracPart: LONGINT; RetValue: String; Begin Original:=RealDialog('Enter Decimal Number', '0.0'); IntPart:=TRUNC(Original); DecPart:=Original-IntPart; FracPart:= Round(DecPart * Base); RetValue:=Concat(IntPart, ' ',FracPart, '/',Base,'"'); Message(Date(2,2),' ', RetValue); End; Run(Test); Quote Link to comment
michaelk Posted October 27, 2020 Share Posted October 27, 2020 Could you solve 4/8 problem by using a case? Assuming that */16 was as accurate as anyone needs to be (as far as I know, only @Bruce Kieffer uses the really little lines on the tape measure). Procedure Test; Const Base=16; Var Original, DecPart: Real; IntPart, FracPart: LONGINT; RetValue: String; RetFract: String; Begin Original:=RealDialog('Enter Decimal Number', '0.0'); IntPart:=TRUNC(Original); DecPart:=Original-IntPart; FracPart:= Round(DecPart * Base); Case FracPart OF 0: RetFract := ''; 1: RetFract := '1/16'; 2: RetFract := '1/8'; 3: RetFract := '3/16'; 4: RetFract := '1/4'; 5: RetFract := '5/16'; 6: RetFract := '3/8'; 7: RetFract := '7/16'; 8: RetFract := '1/2'; 9: RetFract := '9/16'; 10: RetFract := '5/8'; 11: RetFract := '11/16'; 12: RetFract := '3/4'; 13: RetFract := '13/16'; 14: RetFract := '7/8'; 15: RetFract := '15/16'; 16: Begin IntPart := IntPart + 1; RetFract := ''; End; End; RetValue:=Concat(IntPart, ' ',RetFract); Message(Date(2,2),' ', RetValue); End; Run(Test); Quote Link to comment
michaelk Posted October 27, 2020 Share Posted October 27, 2020 Or you can use fewer lines if you do the math for */2, */4, and */8. But I think you still need special cases if the FracPart rounds to 0 or 16. Procedure Test; Const Base=16; Slash='/'; Var Original, DecPart: Real; IntPart, FracPart: LONGINT; RetValue: String; RetFract: String; Begin Original:=RealDialog('Enter Decimal Number', '0.0'); IntPart:=TRUNC(Original); DecPart:=Original-IntPart; FracPart:= Round(DecPart * Base); IF FracPart MOD 2 = 0 then RetFract := Concat(Num2Str(0,FracPart/2),Slash,Num2Str(0,Base/2)); IF FracPart MOD 4 = 0 then RetFract := Concat(Num2Str(0,FracPart/4),Slash,Num2Str(0,Base/4)); If FracPart MOD 8 = 0 then RetFract := Concat(Num2Str(0,FracPart/8),Slash,Num2Str(0,Base/8)); If (FracPart MOD 2 <> 0) AND (FracPart MOD 4 <> 0) AND (FracPart MOD 8 <> 0) then RetFract := Concat(Num2Str(0,FracPart),Slash,Num2Str(0,Base)); Case FracPart OF 0: RetFract := ''; 16: Begin IntPart := IntPart + 1; RetFract := ''; End; End; RetValue:=Concat(IntPart, ' ',RetFract); Message(Date(2,2),' ', RetValue); End; Run(Test); Actually, on the 4th IF you probably don't need to check anything but MOD 2 <> 0. If FracPart is odd then the result is FracPart/Base. Quote Link to comment
Julian Carr Posted October 27, 2020 Author Share Posted October 27, 2020 Thanks to everyone for your help with this. It was actually for a worksheet script to enable door thicknesses to be listed at smaller increments than the document units settings allowed. Below is the final code. I saved the script with the name 'WSFixDoorThickness' so the cell formula to use it would be: =RUNSCRIPT('WSFixDoorThickness') This replaced the standard: =(Door.DoorThickness) In Vw 2021, it would be possible to use RUNEDITSCRIPT() instead and so allow the door thickness to be modified from the worksheet too. It was beyond the remit of this little project however so currently it only reports door the thickness. { FDT (Fix Door Thickness) - v1.0 - 27/10/2020 } Procedure FDT; VAR gr1 : REAL; gh1 : HANDLE; gs1 : STRING; Function Num2FandI(r1 : REAL) : STRING; Const kBase = 16; VAR DecPart: REAL; IntPart, FracPart: LONGINT; RetFract : STRING; BEGIN IntPart := TRUNC(r1); DecPart := r1 - IntPart; FracPart := Round(DecPart * kBase); Num2FandI := Concat(IntPart, ' ',FracPart, '/', kBase, '"'); CASE FracPart OF 0: RetFract := ''; 1: RetFract := '1/16'; 2: RetFract := '1/8'; 3: RetFract := '3/16'; 4: RetFract := '1/4'; 5: RetFract := '5/16'; 6: RetFract := '3/8'; 7: RetFract := '7/16'; 8: RetFract := '1/2'; 9: RetFract := '9/16'; 10: RetFract := '5/8'; 11: RetFract := '11/16'; 12: RetFract := '3/4'; 13: RetFract := '13/16'; 14: RetFract := '7/8'; 15: RetFract := '15/16'; 16: BEGIN IntPart := IntPart + 1; RetFract := ''; END; END; Num2FandI:=Concat(IntPart, ' ',RetFract, '"'); END; { Num2FandI } BEGIN gh1 := WSScript_GetObject; gs1 := GetRField(gh1, 'Door', 'DoorThickness'); IF ValidNumStr(gs1, gr1) THEN WSScript_SetResStr(Num2FandI(gr1)); END; Run(FDT); 1 Quote Link to comment
michaelk Posted October 27, 2020 Share Posted October 27, 2020 Hi Julian I know it's too late, but when I woke up this was floating in my head: Procedure Test; Const Base=16; Slash='/'; Var Original, DecPart: Real; IntPart, FracPart: LONGINT; RetValue: String; RetFract: String; i: Integer; Begin Original:=RealDialog('Enter Decimal Number', '0.0'); IntPart:=TRUNC(Original); DecPart:=Original-IntPart; FracPart:= Round(DecPart * Base); i :=2; While i < Base do begin if FracPart MOD i = 0 then RetFract := Concat(Num2Str(0,FracPart/i),Slash,Num2Str(0,Base/i)); i := i * 2; end; If (FracPart MOD 2 <> 0) then RetFract := Concat(Num2Str(0,FracPart),Slash,Num2Str(0,Base)); Case FracPart OF 0: RetFract := ''; Base: Begin IntPart := IntPart + 1; RetFract := ''; End; End; RetValue:=Concat(IntPart, ' ',RetFract); Message(Date(2,2),' ', RetValue); End; Run(Test); I *think* this will work for any power of 2 base. 1 Quote Link to comment
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.