Dear dialists! Greetings from the unusually warm Bulgaria, where we enjoj the beautiful sunny "winter" (it is like spring)!
I am writing to you to announce a new member of the Box Sundial Family of DeltaCad macros. This is a well known type of Sundial - Horizontal Altitude Dial. It uses the altitude (height) of the Sun to indicate the time. There is a possibility to chose to include or exclude the corrections for the Equation Of Time and for the Longitude (with respect to the Central Meridian of the Time Zone). Excluding both gives the Local Solar Time. Including both gives the Civil and the Daylight Savings Time. To find the time simply put the box on a horizontal place and rotate it until the direction of the central arrow is towards the Sun. Use the shadow of one of the edges on one of the morning or the afternoon drawings. Unfortunately such type of sundial is not useful close to the local noon and also at places with bigger latitude (i.e. closer to the poles) because in such cases the height (altitude) of the sun changes very slow. The Box Dial can be folded to a small flat rectange and you can carry it everywhere with you. After printing "landscape" on A4 paper, you can make a bigger A3 copy, which allows easier reading. The size of the box is still small enough. Recently two of my DeltaCad macros for drawing Box Dials without gnomon were added to the DeltaCad library on the NASS web page http://www.sundials.org/links/local/deltacad/ Two days ago the new macro was also put there - Thank you, Bob! Some more instructions: First of all rename the attachments from sdboxh.ba to sdboxh.bas and sdboxh.zi to sdboxh.zip. I changed deliberately the extensions of the files because some servers do not allow .bas or .zip attachments. If neither of the files is available, simply download the .zip file http://www.sundials.org/links/local/deltacad/zips/SDBoxH.zip There is a fully functioning 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. Zeros for EOT and longitude corrections will give the local time. The initial opening screen contains data for my place. If you want the parameters for your place and your preferences to appear as default, use any text editor to change the lines around 139-145 and save the file as text (ASCII) file. You can send your comments to my e-mail address [EMAIL PROTECTED] (or to the sundial list). I hope you will enjoy my new construction! Best wishes and more sunny days! Valentin Hristov P.S. Some years ago I made another sundial which uses the altitude (heght) of the sun, but it is a PostScript file. You can download QUADRANT.PS from my old web page in Zimbabwe (from 2002, but still alive...): www.uz.ac.zw/science/maths/personal/hristov/index.htm.
'******************************************************** '* SDBOXH.bas is a DeltaCad macro for producing a * '* Pocket Folding Box Horizontal Altitude Sundial * '* with Longitude Correction and EOT Correction. * '* Created by Valentin Hristov ([EMAIL PROTECTED]). * '* One of the edges is 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. '* To find the time simply put the box on a horizontal place and rotate '* it until the direction of the central arrow is towards the Sun. Use '* the morning or the afternoon drawing. '* Unfortunately such type of sundial is not useful close to the local '* noon and also at places with bigger latitude (i.e. closer to the '* poles) because the height (altitude) of the sun changes then very '* slow. '* 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!!! '* Recently two of my DeltaCad macros for drawing Box Dials without gnomon '* were added to the DeltaCad library on the NASS web page '* http://www.sundials.org/links/local/deltacad/ '* 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. '* Zeros for EOT and longitude corrections will give the local time. '* The initial opening screen contains data for my place. If you want '* the parameters for your place and your preferences to appear as '* default, use any text editor to change the lines around 139-145 '* and save the file as text (ASCII) file. '* After printing "landscape" on A4 paper, you can make a bigger A3 '* copy, which allows easier reading. The size of the box is still '* small enough. '* Treat the new macro as my GIFT to all of you for the NEW YEAR 2007. '* By the way, my country Bulgaria is a member of the EU from '* January 1, 2007. '* 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,rot,i,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,d,h,lcr,slc,clc,lr,sl,cl,dr,sd,cd,ir,si,ci As Double Dim xN0,yN0,zN0,xZ0,yZ0,zZ0,xZZ0,yZZ0,zZZ0,rr,sr,cr as Double Dim xNN0,yNN0,zNN0,lNN0,xNN,yNN,xpr,ypr,zpr,dsr,sds,cds as Double Dim lpr0,xpr0,ypr0,zpr0,lpr1,xpr1,ypr1,zpr1,cg,gr,g,sg as Double Dim x0,y0,z0,x1,y1,z1,x2,y2,z2,x3,y3,z3,x4,y4,z4,shac,chac as Double Dim beta,betar,sb,cb,feot,flon,ceot,clon,sh,th,noon as Double Dim decl(366),eot(366),spl(732) As Double Dim count,nl As Integer Dim action,outtext As String Dim bm(13),datetext(13) As String Dim hhv,hhb,hhe,nlcheck As Boolean dcSetLineParms dcBLACK, dcSOLID, dcTHIN dcSetCircleParms dcBLACK, dcSOLID, dcTHIN dcSetTextParms dcPurple, "Tahoma","Bold",0,12,21,0,0 '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 Angles 'Vectors 'Preparation Main 'Latitude 'End of program '************************************** 'Start of subroutines ''''''''''''''''''''''''''''''''''''''' Sub Input_constants_of_sundial Begin Dialog CONSTANTS_INPUT 13,1,200,106, "Input data for the sundial" Text 15,0,180,10, "HORIZONTAL BOX ALTITUDE (HEIGHT) SUNDIAL" Text 15,8,180,10, "with corrections for the latitude and the EOT" Text 15,20,150,10, "Place" Text 15,32,180,10, "Latitude(N>0) Longitude(E>0) Central meridian(E>0)" Text 15,56,180,10, "Lines per hour (1=1hr, 2=30m, 4=15m)" Text 15,68,180,10, "EOT correction (Yes=1,No=0) Longitude correction" TextBox 65,20,120,10, .p TextBox 15,44,30,10, .l TextBox 85,44,30,10, .lon TextBox 155,44,30,10, .cm TextBox 15,80,30,10, .feot TextBox 155,80,30,10, .flon TextBox 155,56,30,10, .nl OKButton 82,90,37,12 End Dialog 'Initialize Dim prompt As constants_input prompt.p = "Lozen-Sofia-Bulgaria" 'Place prompt.l = 42.6 'Latitude prompt.lon = 23.5 'Longitude prompt.cm = 30 'Central meridian prompt.nl = 4 'Lines per hour prompt.feot = 1 'Include or not EOT prompt.flon = 1 'Include or not Longitude 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 nl=prompt.nl feot=prompt.feot flon=prompt.flon if feot<>0 then feot=1 if flon<>0 then flon=1 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) = "J" datetext( 2) = "F" datetext( 3) = "M" datetext( 4) = "A" datetext( 5) = "M" datetext( 6) = "J" datetext( 7) = "J" datetext( 8) = "A" datetext( 9) = "S" datetext(10) = "O" datetext(11) = "N" datetext(12) = "D" datetext(13) = "J" '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 Angles lc=lon-cm 'longitude correction lcr=lc*d2r 'longitude correction in radians slc=sin(lcr) 'sin(longitude correction) clc=cos(lcr) 'cos(longitude correction) lr=l*d2r 'longitude in radians sl=sin(lr) 'sin(latitude) cl=cos(lr) 'cos(latitude) dr=d*d2r 'declination in radians sd=sin(dr) 'sin(declination) cd=cos(dr) 'cos(declination) ir=i*d2r 'inclination in radians si=sin(ir) 'sin(inclination) ci=cos(ir) 'cos(inclination) rr=rot*d2r 'rotation in radians sr=sin(rr) 'sin(rotation) cr=cos(rr) 'cos(rotation) End Sub Sub Vectors 'Celestial North xN0=0 yN0=0 zN0=1 ' 0 hours without longitude correction xZ0=0 yZ0=-1 zZ0=0 ' 0 hours with longitude correction xZZ0=-slc yZZ0=-clc zZZ0=0 End Sub Sub Preparation dcCreateCircle 0,0,.02 x0=xN0 y0=yN0 z0=zN0 convert xNN0=x4 'Celestian N in new coordinates yNN0=y4 zNN0=z4 lNN0=Sqr(xNN0*xNN0+yNN0*yNN0) xNN=xNN0/lNN0 'Unit projection of N in the plane yNN=yNN0/lNN0 if zNN0<0 then xpr=xNN0 ypr=yNN0 zpr=1+zNN0 else xpr=-xNN0 ypr=-yNN0 zpr=1-zNN0 end if lpr0=Sqr(xpr*xpr+ypr*ypr+zpr*zpr) xpr0=xpr/lpr0 'Unit vector for projection ypr0=ypr/lpr0 zpr0=zpr/lpr0 lpr1=Sqr(xpr*xpr+ypr*ypr) xpr1=xpr/lpr1 'Unit vector in the plane ypr1=ypr/lpr1 zpr1=0 if xpr1>=0 then betar=arcsin(ypr1) else if ypr1>=0 then betar=arccos(xpr1) else betar=-arccos(xpr1) end if end if beta=betar*r2d 'angle of the projection in the plane sb=sin(betar) cb=cos(betar) cg=xpr0*xpr1+ypr0*ypr1+zpr0*zpr1 'cos(gnomon) gr=arccos(cg) 'angle of gnomon in radians g=gr*r2d 'angle of gnomon in degrees sg=Sqr(1-cg*cg) 'sin(gnomon) dcCreateLine 0,0,cg,sg End Sub Sub Convert 'rotation to horizontal plane x1=x0 y1=sl*y0+cl*z0 z1=-cl*y0+sl*z0 'rotation for declination of the plane x2=cd*x1-sd*y1 y2=sd*x1+cd*y1 z2=z1 'rotation for the inclination of the plane x3=x2 y3=ci*y2+si*z2 z3=-si*y2+ci*z2 'rotation of the box in its plane x4=cr*x3+sr*y3 y4=-sr*x3+cr*y3 z4=z3 End Sub Sub Main dcCreateLine -5,2.5,-1,2.5 dcCreateLine 1,2.5,5,2.5 dcCreateLine -2,3.45,-1,3.5 dcCreateLine -1,3.5,1,3.5 dcCreateLine 1,3.5,2,3.45 dcCreateLine -5,-2.5,-1,-2.5 dcCreateLine 1,-2.5,5,-2.5 dcCreateLine -2,-3.45,-1,-3.5 dcCreateLine -1,-3.5,1,-3.5 dcCreateLine 1,-3.5,2,-3.45 dcCreateLine -2,-3.45,-2,-2.5 dcCreateLine -2,2.5,-2,3.45 dcCreateLine 2,-3.45,2,-2.5 dcCreateLine 2,2.5,2,3.45 dcCreateLine -5,-2.5,-5,2.5 dcCreateLine 5,-2.5,5,2.5 'dcCreateLine -5,0,-6,0 'dcCreateLine -6,0,-6,1 'dcCreateLine -6,1,-6-sqr(2)/2,1+sqr(2)/2 'dcCreateLine -6-sqr(2)/2,1+sqr(2)/2,-6,1+sqr(2) 'dcCreateLine -6,1+sqr(2),-6+sqr(2)/2,1+sqr(2)/2 'dcCreateLine -6+sqr(2)/2,1+sqr(2)/2,-5,1 'dcCreateLine -6,0,-6,-1 'dcCreateLine -6,-1,-6-sqr(2)/2,-1-sqr(2)/2 'dcCreateLine -6-sqr(2)/2,-1-sqr(2)/2,-6,-1-sqr(2) 'dcCreateLine -6,-1-sqr(2),-6+sqr(2)/2,-1-sqr(2)/2 'dcCreateLine -6+sqr(2)/2,-1-sqr(2)/2,-5,-1 'dcCreateLine 5,0,6,0 'dcCreateLine 6,0,6,1 'dcCreateLine 6,1,6+sqr(2)/2,1+sqr(2)/2 'dcCreateLine 6+sqr(2)/2,1+sqr(2)/2,6,1+sqr(2) 'dcCreateLine 6,1+sqr(2),6-sqr(2)/2,1+sqr(2)/2 'dcCreateLine 6-sqr(2)/2,1+sqr(2)/2,5,1 'dcCreateLine 6,0,6,-1 'dcCreateLine 6,-1,6+sqr(2)/2,-1-sqr(2)/2 'dcCreateLine 6+sqr(2)/2,-1-sqr(2)/2,6,-1-sqr(2) 'dcCreateLine 6,-1-sqr(2),6-sqr(2)/2,-1-sqr(2)/2 'dcCreateLine 6-sqr(2)/2,-1-sqr(2)/2,5,-1 'dcCreateLine -5,3.5,-5,4.5 'dcCreateLine -5,4.5,-6,4.5 'dcCreateLine -6,4.5,-6,3.5 'dcCreateLine -6,3.5,-7,3.5 'dcCreateLine -7,3.5,-7,2.5 'dcCreateLine -7,2.5,-6,2.5 'dcCreateLine -6,2.5,-5,3.5 'dcCreateLine 5,3.5,5,4.5 'dcCreateLine 5,4.5,6,4.5 'dcCreateLine 6,4.5,6,3.5 'dcCreateLine 6,3.5,7,3.5 'dcCreateLine 7,3.5,7,2.5 'dcCreateLine 7,2.5,6,2.5 'dcCreateLine 6,2.5,5,3.5 'dcCreateLine -5,-3.5,-5,-4.5 'dcCreateLine -5,-4.5,-6,-4.5 'dcCreateLine -6,-4.5,-6,-3.5 'dcCreateLine -6,-3.5,-7,-3.5 'dcCreateLine -7,-3.5,-7,-2.5 'dcCreateLine -7,-2.5,-6,-2.5 'dcCreateLine -6,-2.5,-5,-3.5 'dcCreateLine 5,-3.5,5,-4.5 'dcCreateLine 5,-4.5,6,-4.5 'dcCreateLine 6,-4.5,6,-3.5 'dcCreateLine 6,-3.5,7,-3.5 'dcCreateLine 7,-3.5,7,-2.5 'dcCreateLine 7,-2.5,6,-2.5 'dcCreateLine 6,-2.5,5,-3.5 'Arrow dcSetLineParms dcBlack, dcSolid, dcThick dcCreateLine 0,0,1,0 dcCreateLine 1,0,.87,.08 dcCreateLine 1,0,.87,-.08 dcCreateLine .87,.08,.93,0 dcCreateLine .93,0,.87,-.08 'Smiling Sun dcSetCircleParms dcBLACK, dcSOLID, dcTHICK dcCreateCircle 1.5,0,.25 for count=.5 to 11.5 x1=1.5+.25*cos(count*pi/6) y1=.25*sin(count*pi/6) x2=1.5+.4*cos(count*pi/6) y2=.4*sin(count*pi/6) dcCreateLine x1,y1,x2,y2 next count dcCreateLine 1.45,0,1.55,0 dcCreateCircle 1.6,.1,.05 dcCreateCircle 1.6,-.1,.05 dcCreateCircleEx 1.45,0,1.45,.015,1.45, -.015,.15,.1,0,2 'Circle arrows on the teeth 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 dcSetLineParms dcBlack, dcCutting, dcThin dcCreateLine -2,-2.5,-2,2.5 dcCreateLine 2,-2.5,2,2.5 dcCreateLine -3,-2.5,-3,2.5 dcCreateLine 3,-2.5,3,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 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.25,0,0,p dcCreateText -2.5,1,0,"Latitude "+ll dcCreateText -2.5,-1,0,"Longitude "+lol dcSetTextParms dcDarkPurple, "Tahoma","Bold",-90,10,21,0,0 'dcCreateText -2.6,1.5,0,"Declination "+CStr(d) 'dcCreateText -2.6,0,0,"Inclination "+CStr(i) 'dcCreateText -2.6,-1.5,0,"Rotation "+CStr(rot) if flon=0 then dcCreateText -2.75,1.2,0,"Without EOT correction" else dcCreateText -2.75,1.2,0,"With EOT correction" end if if feot=0 then dcCreateText -2.75,-1.2,0,"Without Longitude correction" else dcCreateText -2.75,-1.2,0,"With Longitude correction" end if dcSetLineParms dcBlack, dcSolid, dcThin 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 3.25,0,0,"The box sundial is horizontal and measures the height (altitude) of the sun." dcCreateText 3.5,0,0,"Unfortunately the change of the height is very small close to noon." dcCreateText 3.75,0,0,"The direction toward the sun is given by the central arrow." 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." 'dcSetLineParms dcBlack, dcSolid, dcThin 'for y=-4.5 to -3.5 'for x=-4 to 4 ' dcCreateline x-.1,y,x+.1,y ' dcCreateline x,y-.1,x,y+.1 'next x 'next y 'for y=3.5 to 4.5 'for x=-4 to 4 ' dcCreateline x-.1,y,x+.1,y ' dcCreateline x,y-.1,x,y+.1 'next x 'next y dcSetTextParms dcBlue,"Tahoma","Standard",0,8,21,0,0 dcCreateText 0,2.43,0,"Civil (Winter) time" dcCreateText 0,-.07,0,"Civil (Winter) time" dcSetTextParms dcRed,"Tahoma","Standard",180,8,21,0,0 dcCreateText 0,.07,0,"Daylight Savings (Summer) Time" dcCreateText 0,-2.43,0,"Daylight Savings (Summer) Time" dcSetTextParms dcBlack,"Tahoma","Bold",180,8,21,0,0 dcCreateText -1.5,.07,0,"Morning" dcCreateText -1.5,-2.43,0,"Afternoon" dcSetTextParms dcBlack,"Tahoma","Bold",0,8,21,0,0 dcCreateText -1.5,2.43,0,"Morning" dcCreateText -1.5,-.07,0,"Afternoon" dcSetTextParms dcDarkGreen, "Tahoma","Bold",-90,10,21,0,0 for count=1 to 13 if count-1=Int((count-1)/3)*3 then dcSetLineParms dcBlack, dcSolid,dcThick dcCreateLine -2,2.25-2*bm(count)/366,1,2.25-2*bm(count)/366 dcCreateText 1.3,1.25,0,"MONTH" dcCreateText 1.7,1.25,0,"MORNING" if count<13 then dcCreateText 1.1,2.15-2*bm(count)/366,0,datetext(count) dcCreateLine -2,-.25-2*bm(count)/366,1,-.25-2*bm(count)/366 dcCreateText 1.3,-1.25,0,"MONTH" dcCreateText 1.7,-1.25,0,"AFTERNOON" if count<13 then dcCreateText 1.1,-.35-2*bm(count)/366,0,datetext(count) dcSetLineParms dcBlack, dcSolid, dcThin next count if flon=0 then noon=12 else noon=12-int(lc/15+.5) 'civil hour closest to the "mean local noon" end if '''''''''''''''''''''''''''''''''''''''''''''''''''''''''' cs=0 'counter for spline for ha=0 to noon step 1/nl ' civil and daylight savings labels if ha=Int(ha) then dcSetLineParms dcDarkPurple,dcSolid,dcThick ham=ha-1 ham=ham-Int(ham/12)*12+1 'ha (12) ham1=ham ham1=ham1-Int(ham1/12)*12+1 'ha+1 (12) 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+flon*lc-feot*eot(count)/4 hac=hac+180 hacr=hac*d2r shac=sin(hacr) chac=cos(hacr) dsr=decl(count)*d2r sds=sin(dsr) cds=cos(dsr) ' sds=sin(-dsr) ' cds=cos(-dsr) sh=sds*sl+cds*cl*chac 'sin of the height th=sh/sqr(1-sh*sh) 'tan of the height ' x0=-shac*cds ' y0=-chac*cds ' z0=sds ' convert if sh>=0 then cs=cs+1 if th<1/2 then spl(2*cs-1)=-2+2*th else spl(2*cs-1)=1-1/th end if spl(2*cs)=2.25-2*count/366 xe=spl(2*cs-1) ye=spl(2*cs) if hhb=True then xb=spl(2*cs-1) yb=spl(2*cs) if ha=Int(ha) then if xb>-1.95 then dcSetTextParms dcBlue, "Tahoma","Standard",0,8,21,0,0 dcCreateText xb,yb+.07,0,CStr(ham) else dcSetTextParms dcBlue, "Tahoma","Standard",-90,8,21,0,0 dcCreateText xb-.07,yb,0,CStr(ham) end if end if hhb=False hhv=True end if else if cs>2 then dcCreateSpline spl(1),cs,False cs=0 else if cs=2 then dcCreateLine spl(1),spl(2),spl(3),spl(4) 'else 'dcCreateCircle spl(1),spl(2),.02 end if cs=0 end if 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 spl(1),spl(2),spl(3),spl(4) 'else 'dcCreateCircle spl(1),spl(2),.02 end if end if if ha=Int(ha) and hhe=False and hhv=True then if xb>-1.95 then dcSetTextParms dcRed, "Tahoma","Standard",180,8,21,0,0 dcCreateText xe,ye-.07,0,CStr(ham1) else dcSetTextParms dcRed, "Tahoma","Standard",-90,8,21,0,0 dcCreateText xe-.07,ye,0,CStr(ham1) end if end if cs=0 dcSetLineParms dcBlack,dcThin next ha '''''''''''''''''''''''''''''''''''''''''''''''''''''''''' cs=0 'counter for spline for ha=noon to 24 step 1/nl ' civil and daylight savings labels if ha=Int(ha) then dcSetLineParms dcDarkPurple,dcSolid,dcThick ham=ha-1 ham=ham-Int(ham/12)*12+1 'ha (12) ham1=ham ham1=ham1-Int(ham1/12)*12+1 'ha+1 (12) 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+flon*lc-feot*eot(count)/4 hac=hac+180 hacr=hac*d2r shac=sin(hacr) chac=cos(hacr) dsr=decl(count)*d2r sds=sin(dsr) cds=cos(dsr) ' sds=sin(-dsr) ' cds=cos(-dsr) sh=sds*sl+cds*cl*chac 'sin of the height th=sh/sqr(1-sh*sh) 'tan of the height ' x0=-shac*cds ' y0=-chac*cds ' z0=sds ' convert if sh>=0 then cs=cs+1 if th<1/2 then spl(2*cs-1)=-2+2*th else spl(2*cs-1)=1-1/th end if spl(2*cs)=-.25-2*count/366 xe=spl(2*cs-1) ye=spl(2*cs) if hhb=True then xb=spl(2*cs-1) yb=spl(2*cs) if ha=Int(ha) then dcSetTextParms dcBlue, "Tahoma","Standard",0,8,21,0,0 if xb>-1.95 then dcSetTextParms dcBlue, "Tahoma","Standard",0,8,21,0,0 dcCreateText xb,yb+.07,0,CStr(ham) else dcSetTextParms dcBlue, "Tahoma","Standard",-90,8,21,0,0 dcCreateText xb-.07,yb,0,CStr(ham) end if end if hhb=False hhv=True end if else if cs>2 then dcCreateSpline spl(1),cs,False cs=0 else if cs=2 then dcCreateLine spl(1),spl(2),spl(3),spl(4) 'else 'dcCreateCircle spl(1),spl(2),.02 end if cs=0 end if 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 spl(1),spl(2),spl(3),spl(4) 'else 'dcCreateCircle spl(1),spl(2),.02 end if end if if ha=Int(ha) and hhe=False and hhv=True then dcSetTextParms dcRed, "Tahoma","Standard",0,8,21,0,0 if xb>-1.95 then dcSetTextParms dcRed, "Tahoma","Standard",180,8,21,0,0 dcCreateText xe,ye-.07,0,CStr(ham1) else dcSetTextParms dcRed, "Tahoma","Standard",-90,8,21,0,0 dcCreateText xe-.07,ye,0,CStr(ham1) 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
SDBoxH.zi
Description: Binary data
--------------------------------------------------- https://lists.uni-koeln.de/mailman/listinfo/sundial
