Greetings to the Sundial Community from Bulgaria! I am writing to you to announce that I prepared a DeltaCad macro which produces a Portable Folding Box Polar Gnomonless Sundial with corrections for the longitude and the EOT (equation of time) and suitable for any latitude (N or S).
Some of the interesting (in my opinion) features: - When used, it is a rectangular box. - The shadows of two of the edges indicate the civil and daylight savings time. - Two latitude angles support the box so that the two edges used as gnomons are in N-S celestial direction. - The main rectangle may face different local celestial directions. a) South - local time from 6 to 18 (main position). b) East - 0 to 12. c) West - 12 to 24. - Suitable for the Northern and Southern hemispheres. - When folded, it is a flat rectangle smaller than 10 x 4 cm if printed "landscape" on A4, or 13 x 5.5 cm enlarged by copying on A3. You can add other features in your comments sent to my e-mail address [EMAIL PROTECTED] (or to the sundial list). Some of the members already gave their opinion using the draft copy of the file and encouraged me to share it with the community. I do not know if such construction does exist and I will be very grateful if you comment this, too. You can use a Demo version of DeltaCad from www.deltacad.com. First of all rename the attachment from sdbox.ba to sdbox.bas. I changed deliberately the extension of the file because some servers do not allow .bas attachments. To run the macro in DeltaCad, use the menu "Option-Macro-Run" or click on the separate button "Macro" where you have to add the macro to the list. You can read also the comments in the beginning of the file by any editor. I hope you will enjoy my new construction! Best wishes to all of you! Valentin Hristov
'******************************************************** '* NOT FINISHED YET - VARIANT FOR TESTING * '* SDBOX.bas is a DeltaCad macro for producing a * '* Pocket Folding Box Polar Gnomonless Sundial with * '* Longitude Correction and EOT Correction * '* created by Valentin Hristov ([EMAIL PROTECTED]) * '* Two of the edges are used as a gnomon. * '* I was inspired by Mac Oglesby to use the * '* North American Sundial Society DeltaCad programs * '* as tutorials (http://sundials.org) and made with * '* DeltaCad (www.deltacad.com) * '* different types of sundials. * '******************************************************** '* To assemble the sundial, cut along the solid lines, make mountain folds '* along the lines with long dashes, and valley folds along the lines '* with short dashes. '* The design allows the sundial to face East, South, or West, which is '* enough to read the civil or daylight savings time at any moment. '* It is possible to glue the bottoms of two such boxes, facing East and '* West (or South and North) and then you can keep the sundial unmovable. '* Both civil time and daylight savings time are shown. Adjust the '* time and the sundial can be used as a compass to indicate the '* North-South direction. '* Printing landscape on A4 paper gives a really portable sundial. '* You can use a copy machine to enlarge to A3 if you wish to have '* a bigger size. '* If you want to use the sundial at different places, then it is '* suitable to give zero values for latitude, longitude, and central '* meridian. The Equation Of Time will be included, but you will have to '* make correction for the longitude with respect to the central meridian '* of the time zone (1 gegree = 4 minutes). While cutting keep the '* semi-circles with the degrees in order to be able to adjust the slope '* for the latitude by suitable folding. '* You can see the picture of another type of sundial generated by one '* of my DeltaCad macros at '* www.flickr.com/photos/Valentin_Hristov/261303801/ '* Click on the button "All sizes" to see a bigger photo with details. '* I am very grateful to my friends Daniela (www.danyo.net) and '* Todor (www.todor.org) who converted my drawing into a real art piece!!! '* There is a Demo version of DeltaCad at www.deltacad.com. '* Use the menu "Options - Macro - Run..." or the separate "Macro" '* button - "Edit Macro List", add the file, and "Run Macro". '* In the dialog box use DECIMAL DEGREES. Negative values indicate '* South for latitude and West for longitude and central meridian. '* E N J O Y !!! Option Explicit ' Force all variables to be declared before they are used. No adhoc variables dcSetLineParms dcBlack, dcSolid, dcThin Dim l,p,lon,cm,pi,d2r,r2d,dm,dmr,w,ll,ud,lol,s,cs As Double Dim ha,ham,ham1,has,has1,lc,hac,tir,hacr,thac,xe,ye,xb,yb As Double Dim x,y As Double 'Dim decl(366) As Double Dim eot(366),spl(732) As Double Dim count As Integer Dim action,outtext As String Dim bm(13),datetext(13) As String Dim hhv,hhb,hhe As Boolean dcSetLineParms dcBLACK, dcSOLID, dcTHIN dcSetCircleParms dcBLACK, dcSOLID, dcTHIN 'Establish the 5 standard line thicknesses in thousands of an inch. dcSetDrawingData dcLineThin, .003 dcSetDrawingData dcLineNormal, .008 dcSetDrawingData dcLineThick, .012 dcSetDrawingData dcLineHeavy, .024 dcSetDrawingData dcLineWide, .048 'Maximize the window, close any existing drawing without saving, and start a new drawing. dcSetDrawingWindowMode dcMaximizeWin dcCloseWithoutSaving dcNew "" '************************************** 'Start of program init_constants Input_constants_of_sundial Main Latitude 'End of program '************************************** 'Start of subroutines ''''''''''''''''''''''''''''''''''''''' Sub Input_constants_of_sundial Begin Dialog CONSTANTS_INPUT 13,1,200,84, "Input data for the sundial" Text 15,0,300,10, "Polar Gnomonless Folding Pocket Sundial" Text 15,8,150,10, "with corrections for the latitude and the EOT" Text 15,20,150,10, "Place" Text 15,32,150,10, "Latitude (N is positive, S is negative)" Text 15,44,150,10, "Longitude (E is positive, W is negative)" Text 15,56,150,10, "Central meridian (E is > 0, W is < 0)" Text 130,68,160,10, "(decimal degrees)" TextBox 88,20,99,10, .p TextBox 150,32,37,10, .l TextBox 150,44,37,10, .lon TextBox 150,56,37,10, .cm OKButton 82,68,37,12 End Dialog 'Initialize Dim prompt As constants_input prompt.p = "Lozen - Sofia - Bulgaria" prompt.l = 42.6 prompt.lon = 23.5 prompt.cm = 30 repeat_until_inputcorrect: 'label to return if input is not correct action = Dialog(prompt) 'get the input If test("l",prompt.l,-90,90) = false Then GoTo repeat_until_inputcorrect End If If test("lon",prompt.lon,-180,180) = false Then GoTo repeat_until_inputcorrect End If If test("cm",prompt.cm,-180,180) = false Then GoTo repeat_until_inputcorrect End If 'Set program variables with input variables, angles in degrees p = prompt.p l = prompt.l lon = prompt.lon cm = prompt.cm lc=lon-cm 'longitude correction End Sub ''''''''''''''''''''''''''''''''''''''' Sub init_constants pi = 4 * Atn(1) d2r = pi/180 r2d = 180/pi dm = 23.43954 dmr = dm*d2r bm( 1)= 1 '1jan bm( 2)= 32 '1feb bm( 3)= 60 bm( 4)= 91 bm( 5)=121 bm( 6)=152 bm( 7)=182 bm( 8)=213 bm( 9)=244 bm(10)=274 bm(11)=305 bm(12)=335 '1dec bm(13)=366 '1jan 'for count=1 to 365 'w=.017202792*(count-(cm-15)/360) 'decl(count)=.3831+23.26*cos(w-2.9633)+.3551*cos(2*w -3.066)+.1342*cos(3*w-2.5838)+.0326*cos(4*w+.0515) 'next count 'decl(366)=decl(1) for count=1 to 365 w=.017202792*(count-(cm-15)/360) eot(count)=7.3656*cos(w+1.4940)+9.9158*cos(2*w+1.9230)+.3060*cos(3*w-1.8081)+.2026*cos(4*w+2.2525) eot(count)=-eot(count) next count eot(366)=eot(1) datetext( 1) = "jan" datetext( 2) = "feb" datetext( 3) = "mar" datetext( 4) = "apr" datetext( 5) = "may" datetext( 6) = "jun" datetext( 7) = "jul" datetext( 8) = "aug" datetext( 9) = "sep" datetext(10) = "oct" datetext(11) = "nov" datetext(12) = "dec" datetext(13) = "jan" End Sub Sub Main dcCreateLine -5,2.5,-1,2.5 dcCreateLine 1,2.5,5,2.5 dcCreateLine -2,3.5,2,3.5 dcCreateLine -5,-2.5,-1,-2.5 dcCreateLine 1,-2.5,5,-2.5 dcCreateLine -2,-3.5,+2,-3.5 dcCreateLine -2,-3.5,-2,-2.5 dcCreateLine -2,2.5,-2,3.5 dcCreateLine 2,-3.5,2,-2.5 dcCreateLine 2,2.5,2,3.5 dcCreateLine -7,-2,-7,2 dcCreateLine 7,-2,7,2 dcSetLineParms dcBlack, dcCutting, dcThin dcCreateLine -2,-3.5,-2,3.5 dcCreateLine 2,-3.5,2,3.5 dcCreateLine -3,-2.5,-3,2.5 dcCreateLine 3,-2.5,3,2.5 dcCreateLine -5,-2.5,-5,2.5 dcCreateLine 5,-2.5,5,2.5 dcCreateLine -1,-2.5,0,-3.5 dcCreateLine 0,-3.5,1,-2.5 dcCreateLine -1,2.5,0,3.5 dcCreateLine 0,3.5,1,2.5 dcSetLineParms dcBlack, dcStitch, dcThin dcCreateLine -1,2.5,1,2.5 dcCreateLine -1,-2.5,1,-2.5 dcCreateLine -1,-3.5,-1,3.5 dcCreateLine 1,-3.5,1,3.5 dcCreateLine 4,-2.5,4,2.5 dcCreateLine -4,-2.5,-4,2.5 dcSetCircleParms dcBlack, dcArrow, dcThin dcCreateCircleEx -1, 2.5,-1.5, 3.5,-2, 3,.9,.9,0,2 dcCreateCircleEx -1,-2.5,-2,-3,-1.5,-3.5,.9,.9,0,1 dcCreateCircleEx 1, 2.5, 2, 3, 1.5, 3.5,.9,.9,0,1 dcCreateCircleEx 1,-2.5, 1.5,-3.5, 2,-3,.9,.9,0,2 if l>=0 then ll=CStr(l)+" N" ud=0 else ll=CStr(-Val(l))+" S" ud=180 end if if lon>=0 then lol=CStr(lon)+" E" else lol=CStr(-Val(lon))+" W" dcSetTextParms dcDarkPurple, "Tahoma","Bold",-90,12,21,0,0 dcCreateText -2.3,0,0,p dcCreateText -2.7,1,0,"Latitude "+ll dcCreateText -2.7,-1,0,"Longitude "+lol dcSetTextParms dcDarkPurple, "Tahoma","Bold",90,12,21,0,0 dcCreateText 3.3,0,0,p dcCreateText 3.7,-1,0,"Latitude "+ll dcCreateText 3.7,1,0,"Longitude "+lol dcSetTextParms dcDarkPurple, "Tahoma","Bold",ud,12,21,0,0 dcCreateText 0,2.4,0,"N" dcCreateText 0,-2.4,0,"S" dcSetLineParms dcDarkPurple, dcSolid, dcNormal dcCreateLine 0,2.3,.1,2.1 dcCreateLine 0,2.3,-.1,2.1 dcCreateLine 0,2.2,.1,2.1 dcCreateLine 0,2.2,-.1,2.1 dcCreateLine 0,-2.3,.1,-2.1 dcCreateLine 0,-2.3,-.1,-2.1 dcCreateLine 0,-2.2,.1,-2.1 dcCreateLine 0,-2.2,-.1,-2.1 dcSetLineParms dcBlack, dcSolid, dcThin dcSetTextParms dcDarkGreen, "Tahoma","Standard",ud,10,21,0,0 dcCreateText 0,0,0,"South or North" dcCreateText 0,1.95,0,"East or West" dcCreateText 0,-1.95,0,"East or West" dcSetTextParms dcBlack,"Tahoma","Bold",-90,10,21,0,0 dcCreateText -3.3,0,0,"Author: Valentin Hristov, Sofia, Bulgaria" dcCreateText -3.5,0,0,"E-mail: [EMAIL PROTECTED]" dcSetTextParms dcBlack,"Tahoma","Standard",-90,8,21,0,0 dcCreateText -3.7,0,0,"Old (2002) web page: www.uz.ac.zw/science/maths/personal/hristov/index.htm" dcCreateText -4.3,0,0,"Cut along the solid lines." dcCreateText -4.5,0,0,"Make mountain folds along the lines with long dashes." dcCreateText -4.7,0,0,"Make valley folds along the lines with short dashes." dcSetTextParms dcBlack,"Tahoma","Bold",90,10,21,0,0 dcCreateText 2.3,0,0,"Author: Valentin Hristov, Sofia, Bulgaria" dcCreateText 2.5,0,0,"E-mail: [EMAIL PROTECTED]" dcSetTextParms dcBlack,"Tahoma","Standard",90,8,21,0,0 dcCreateText 2.7,0,0,"Old (2002) web page: www.uz.ac.zw/science/maths/personal/hristov/index.htm" dcCreateText 4.3,0,0,"Cut along the solid lines." dcCreateText 4.5,0,0,"Make mountain folds along the lines with long dashes." dcCreateText 4.7,0,0,"Make valley folds along the lines with short dashes." for count=1 to 13 dcSetTextParms dcDarkGreen, "Tahoma","Standard",ud,7,21,0,0 dcCreateLine -2,1.5-bm(count)/366,s+1,1.5-bm(count)/366 if count<13 then dcCreateText 0,1.455-bm(count)/366,0,datetext(count) dcSetTextParms dcDarkGreen, "Tahoma","Standard",ud,7,21,0,0 dcCreateLine -1,-.5-bm(count)/366,s+2,-.5-bm(count)/366 if count<13 then dcCreateText 0,-.545-bm(count)/366,0,datetext(count) dcSetTextParms dcDarkGreen, "Tahoma","Standard",ud,7,21,0,0 next count '''''''''''''''''''''''''''''''''''''''''''''''''''''''''' cs=0 'counter for spline for ha=0 to 12 step .25 ham=ha-1 ham1=ham+6 ham=ham-Int(ham/12)*12+1 ham1=ham1-Int(ham1/12)*12+1 has=ham+1 has1=ham1+1 if has=13 then has=1 if has1=13 then has1=1 hac=ha*15+lc if ha=Int(ha) then dcSetLineParms dcDarkPurple,dcSolid,dcNormal tir=tan(hac*d2r) if tir>=0 then if tir<=2 then dcCreateLine -1+tir,-.4,-1+tir,-1.6 dcSetTextParms dcDarkBlue, "Tahoma","Standard",ud,7,21,0,0 dcCreateText -1+tir,-.3,0,CStr(ham) dcCreateText -1+tir,-1.7,0,CStr(ham1) dcSetTextParms dcRed, "Tahoma","Standard",ud,7,21,0,0 dcCreateText -1+tir,-.2,0,CStr(has) dcCreateText -1+tir,-1.8,0,CStr(has1) else dcCreateLine 2-2/tir,-.4,2-2/tir,-1.6 dcSetTextParms dcDarkBlue, "Tahoma","Standard",ud,7,21,0,0 dcCreateText 2-2/tir,-.3,0,CStr(ham) dcCreateText 2-2/tir,-1.7,0,CStr(ham1) dcSetTextParms dcRed, "Tahoma","Standard",ud,7,21,0,0 dcCreateText 2-2/tir,-.2,0,CStr(has) dcCreateText 2-2/tir,-1.8,0,CStr(has1) end if end if if tir<=0 then if tir>=-2 then dcCreateLine 1+tir,.4,1+tir,1.6 dcSetTextParms dcDarkBlue, "Tahoma","Standard",ud,7,21,0,0 dcCreateText 1+tir,.3,0,CStr(ham) dcCreateText 1+tir,1.7,0,CStr(ham1) dcSetTextParms dcRed, "Tahoma","Standard",ud,7,21,0,0 dcCreateText 1+tir,.2,0,CStr(has) dcCreateText 1+tir,1.8,0,CStr(has1) else dcCreateLine -2-2/tir,.4,-2-2/tir,1.6 dcSetTextParms dcDarkBlue, "Tahoma","Standard",ud,7,21,0,0 dcCreateText -2-2/tir,.3,0,CStr(ham) dcCreateText -2-2/tir,1.7,0,CStr(ham1) dcSetTextParms dcRed, "Tahoma","Standard",ud,7,21,0,0 dcCreateText -2-2/tir,.2,0,CStr(has) dcCreateText -2-2/tir,1.8,0,CStr(has1) end if end if dcSetLineParms dcDarkPurple,dcSolid,dcThick end if hhv=False hhb=True hhe=False ' for count=1 to 366 'max number of points in Spline is 248 for count=1 to 366 step 2 hac=ha*15+lc-eot(count)/4 hacr=hac*d2r thac=tan(hacr) if thac<=0 then cs=cs+1 if thac>-2 then spl(2*cs-1)=1+thac else spl(2*cs-1)=-2-2/thac end if spl(2*cs)=1.5-count/366 xe=spl(2*cs-1) ye=spl(2*cs) if hhb=True then xb=spl(2*cs-1) yb=spl(2*cs) hhb=False hhv=True end if else if cs>2 then dcCreateSpline spl(1),cs,False else if cs=2 then dcCreateLine spl(1),spl(2),spl(3),spl(4) 'else 'dcCreateCircle spl(1),spl(2),.02 end if end if cs=0 end if next count hhe=False if cs>2 then 'if the hour line finishes at 365 dcCreateSpline spl(1),cs,False else if cs=2 then dcCreateLine s+spl(1),spl(2),s+spl(3),spl(4) 'else 'dcCreateCircle spl(1),spl(2),.02 end if end if cs=0 dcSetLineParms dcBlack,dcThin next ha cs=0 'counter for spline for ha=0 to 23.999 step .25 hac=ha*15+lc if ha=Int(ha) then dcSetLineParms dcDarkPurple,dcSolid,dcNormal tir=tan(hac*d2r) if tir>=0 then if tir<=2 then dcCreateLine -1+tir,-.4,-1+tir,-1.6 else dcCreateLine 2-2/tir,-.4,2-2/tir,-1.6 end if end if if tir<=0 then if tir>=-2 then dcCreateLine 1+tir,.4,1+tir,1.6 else dcCreateLine -2-2/tir,.4,-2-2/tir,1.6 end if end if dcSetLineParms dcDarkPurple,dcSolid,dcThick end if hhv=False hhb=True hhe=False ' for count=1 to 366 'max number of points in Spline is 248 for count=1 to 366 step 2 hac=ha*15+lc-eot(count)/4 hacr=hac*d2r thac=tan(hacr) if thac>=0 then cs=cs+1 if thac<2 then spl(2*cs-1)=-1+thac else spl(2*cs-1)=2-2/thac end if spl(2*cs)=-.5-count/366 xe=spl(2*cs-1) ye=spl(2*cs) if hhb=True then xb=spl(2*cs-1) yb=spl(2*cs) end if hhb=False hhv=True else if cs>2 then dcCreateSpline spl(1),cs,False else if cs=2 then dcCreateLine spl(1),spl(2),spl(3),spl(4) 'else 'dcCreateCircle spl(1),spl(2),.02 end if end if cs=0 end if next count hhe=False if cs>2 then 'if the hour line finishes at 365 dcCreateSpline spl(1),cs,False else if cs=2 then dcCreateLine s+spl(1),spl(2),s+spl(3),spl(4) 'else 'dcCreateCircle spl(1),spl(2),.02 end if end if cs=0 dcSetLineParms dcBlack,dcThin next ha End Sub ''''''''''''''''''''''''''''''''''''''' Sub Latitude dcCreateCircleEx -5,0,-5,2.5,-5,-2.5,2.5,2.5,0,0 dcCreateCircleEx 5,0,5,-2.5,5,2.5,2.5,2.5,0,0 for count=90 to 270 step 2 x=cos(count*d2r) y=sin(count*d2r) dcCreateLine -5+2.5*x,2.5*y,-5+2.55*x,2.55*y next count for count=90 to 270 step 10 x=cos(count*d2r) y=sin(count*d2r) dcCreateLine -5+2.5*x,2.5*y,-5+2.6*x,2.6*y next count for count=90 to 270 step 20 x=cos(count*d2r) y=sin(count*d2r) dcCreateLine -5+2.5*x,2.5*y,-5+2.65*x,2.65*y next count for count=-90 to 90 step 2 x=cos(count*d2r) y=sin(count*d2r) dcCreateLine 5+2.5*x,2.5*y,5+2.55*x,2.55*y next count for count=-90 to 90 step 10 x=cos(count*d2r) y=sin(count*d2r) dcCreateLine 5+2.5*x,2.5*y,5+2.6*x,2.6*y next count for count=-90 to 90 step 20 x=cos(count*d2r) y=sin(count*d2r) dcCreateLine 5+2.5*x,2.5*y,5+2.65*x,2.65*y next count if l>=0 then ll=l else ll=90+l x=cos((90+2*ll)*d2r) y=sin((90+2*ll)*d2r) dcCreateLine -5+2.5*x,2.5*y,-5,2.5 dcCreateLine -5+2.5*x,2.5*y,-5,-2.5 x=cos((90-2*ll)*d2r) y=sin((90-2*ll)*d2r) dcCreateLine 5+2.5*x,2.5*y,5,2.5 dcCreateLine 5+2.5*x,2.5*y,5,-2.5 End Sub ''''''''''''''''''''''''''''''''''''''' Function arcsin(ByVal x) As Double If Abs(x) > 0.999999999999 Then x = sgn(x)*0.999999999999 arcsin = Atn(x/Sqr(1-x*x)) End Function Function arccos(ByVal x) As Double arccos = pi/2-arcsin(x) End Function Function test(varname,x,minval,maxval) As boolean If IsNumeric(x) = false Then test = false outtext = varname & " must be numeric" MsgBox outtext exit Function End If If x < minval Or x > maxval Then outtext = varname & " must be between " & chr$(13) & minval & " and " & maxval MsgBox outtext exit Function End If test = true End Function
--------------------------------------------------- https://lists.uni-koeln.de/mailman/listinfo/sundial
