' STAR AND SUN CLOCK (for the Northern Hemisphere) ' Author: Valentin Hristov (valhrist@bas.bg) ' Web page: www.math.bas.bg/complan/valhrist/mystuff.htm ' Variant for testing. ' The data contains 900 stars (magn <= 4.5) but only stars with ' declination between -30 and +90 are shown (the whole Northern plus part ' of the Southern Hemisphere). You can choose the maximal magnitude of ' the shown stars by editing line 192 in this file. ' Print only the "default" layer on usual sheet of paper and the ' "Az-Ht-Dt" layer on transparent one. Cut both along the outermost ' circles. Use a suitable pin to keep the two sheets together at their ' centres. ' The choise of the layer for printing is made in the menu ' File - Set Print Region... ' Star clock ' The position of the constelations Ursa Major and Cassiopea with ' respect to the Polar star in Ursa minor is used. Find the Polar star ' in the sky and face it. ' Keep the transparent sheet with its North mark (N) down and South ' mark (S) up. Rotate the other (usual) sheet until the positions of Ursa ' Major and Cassiopea correspond to their real position in the sky. ' Then against the date you can read the civil or daylight savings time. ' Vice versa, if you put the date against the time, then the proper ' position of Ursa Major and Cassiopea appears if you keep the North ' mark (N) down. ' Sun Clock ' The position of the sun among the stars is indicated for every day by ' a point but only the dates 1,6,11,16,21,26 of every month are labeled. ' If you measure somehow the azimuth or the height of the sun, then ' rotate the sheets so that the date mark on the ecliptic curve to be at ' the measured azimuth or height position. Then read the time against ' the date on the outside circles. ' Be careful if you use the height because the sun has equal hights ' twice a day - once before and once after the local noon. ' Vice versa, if you put the time (standard or daylight savings) against ' the date, then you can find the azimuth and the height of the sun. ' You can measure the height of the sun using a part of the printing of ' my macro "Sun position" from my page ' www.math.bas.bg/complan/valhrist/mystuff.htm. ' Enjoy! ' August 2009 Option Explicit ' Force all variables to be declared before they are used. No adhoc variables Dim ma(900),ra(900),de(900),xx(21),yy(21),m(21) as double Dim pi,r,x,y,a,l,lo,cm,ll,w,d2r as double Dim h,hr,ar,lr,sd,cd,td,dr,t2d,r2d,d,ct,st,f,he,stp,mg as double Dim i,j as integer Dim star,mm(12),p,outtext,action,button As String Dim inputcorrect As boolean dcSetDrawingWindowMode dcMaximizeWin dcCloseWithoutSaving dcNew "" dcSetDrawingScale 25.4 'Calculate in millimeters '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 pi=4*Atn(1) d2r=pi/180 r2d=180/pi Initial_Data dcSetLineParms dcBlack, dcSOLID, dcThick dcCreateLine -30,0,30,0 dcCreateLine 0,-30,0,30 dcSetLineParms dcBLACK, dcSOLID, dcTHIN dcSetCircleParms dcBLACK, dcSOLID, dcTHIN for i = 15 to 120 step 15 dcCreateCircle 0,0,i next i dcCreateCircle 0,0,135 dcCreateCircle 0,0,150 for i = 0 to 23 ' hour marks x=15*cos(i*pi/12) y=-15*sin(i*pi/12) dcCreateLine x,y,8*x,8*y dcSetTextParms dcBlue,"Times New Roman","Bold",90-i*15,12,5,0,0 dcCreateText 8.4*x,8.4*y,0,CStr(i) dcSetTextParms dcRed, "Times New Roman","Bold",90-i*15,12,5,0,0 dcCreateText 8.7*x,8.7*y,0,CStr(i+1) dcSetTextParms dcBlack, "Times New Roman","Standard",90-(i+1/3)*15,7,5,0,0 x=15*cos((i+1/3)*pi/12) y=-15*sin((i+1/3)*pi/12) dcCreateText 8.7*x,8.7*y,0,CStr(20) dcSetTextParms dcBlack, "Times New Roman","Standard",90-(i+2/3)*15,7,5,0,0 x=15*cos((i+2/3)*pi/12) y=-15*sin((i+2/3)*pi/12) dcCreateText 8.7*x,8.7*y,0,CStr(40) next i for i = 0 to 288 ' 5 min marks x=135*cos(i*pi/144) y=-135*sin(i*pi/144) dcCreateLine x,y,.98*x,.98*y next i 'Sun path m(1)=0:mm(1)="1 Jan" m(2)=31:mm(2)="1 Feb" m(3)=59:mm(3)="1 Mar" m(4)=90:mm(4)="1 Apr" m(5)=120:mm(5)="1 May" m(6)=151:mm(6)="1 Jun" m(7)=181:mm(7)="1 Jul" m(8)=212:mm(8)="1 Aug" m(9)=243:mm(9)="1 Sep" m(10)=273:mm(10)="1 Oct" m(11)=304:mm(11)="1 Nov" m(12)=334:mm(12)="1 Dec" Dim decl(366),eot(366) As Double for i=1 to 365 w=.017202792*(i-(cm-15)/360) decl(i)=.367402-23.275*cos(w+.178044)-.38506*cos(2*w+.0687076) _ -.16046*cos(3*w+.451301)+.00315469*cos(4*w+.876643) next i decl(366)=decl(1) for i=1 to 365 w=.017202792*(i-(cm-15)/360) eot(i)=.00884207-7.36034*cos(w+1.49487)+9.91068*cos(2*w-1.21808) _ -.306344*cos(3*w+1.82055)+.204774*Cos(4*w-.875115) next i eot(366)=eot(1) dcSetCircleParms dcPurple,dcFill,dcThin for i=1 to 12 x=-(90-decl(m(i)+1))*cos(((m(i)+1)*360/365+eot(m(i)+1)/4+100.375)*d2r) y=(90-decl(m(i)+1))*sin(((m(i)+1)*360/365+eot(m(i)+1)/4+100.375)*d2r) dcCreateCircle x,y,1 dcCreateCircle x,y,.7 dcSetTextParms dcPurple, "Times New Roman","Bold",(265-m(i))*360/365,10,4,0,0 dcCreateText .97*x,.97*y,0,mm(i) x=-(90-decl(m(i)+6))*cos(((m(i)+6)*360/365+eot(m(i)+6)/4+100.375)*d2r) y=(90-decl(m(i)+6))*sin(((m(i)+6)*360/365+eot(m(i)+6)/4+100.375)*d2r) dcCreateCircle x,y,.7 dcSetTextParms dcPurple, "Times New Roman","Standard",(260-m(i))*360/365,10,4,0,0 dcCreateText .97*x,.97*y,0,6 x=-(90-decl(m(i)+11))*cos(((m(i)+11)*360/365+eot(m(i)+11)/4+100.375)*d2r) y=(90-decl(m(i)+11))*sin(((m(i)+11)*360/365+eot(m(i)+11)/4+100.375)*d2r) dcCreateCircle x,y,.7 dcSetTextParms dcPurple, "Times New Roman","Standard",(255-m(i))*360/365,10,4,0,0 dcCreateText .97*x,.97*y,0,11 x=-(90-decl(m(i)+16))*cos(((m(i)+16)*360/365+eot(m(i)+16)/4+100.375)*d2r) y=(90-decl(m(i)+16))*sin(((m(i)+16)*360/365+eot(m(i)+16)/4+100.375)*d2r) dcCreateCircle x,y,.7 dcSetTextParms dcPurple, "Times New Roman","Standard",(250-m(i))*360/365,10,4,0,0 dcCreateText .97*x,.97*y,0,16 x=-(90-decl(m(i)+21))*cos(((m(i)+21)*360/365+eot(m(i)+21)/4+100.375)*d2r) y=(90-decl(m(i)+21))*sin(((m(i)+21)*360/365+eot(m(i)+21)/4+100.375)*d2r) dcCreateCircle x,y,.7 dcSetTextParms dcPurple, "Times New Roman","Standard",(245-m(i))*360/365,10,4,0,0 dcCreateText .97*x,.97*y,0,21 x=-(90-decl(m(i)+26))*cos(((m(i)+26)*360/365+eot(m(i)+26)/4+100.375)*d2r) y=(90-decl(m(i)+26))*sin(((m(i)+26)*360/365+eot(m(i)+26)/4+100.375)*d2r) dcCreateCircle x,y,.7 dcSetTextParms dcPurple, "Times New Roman","Standard",(240-m(i))*360/365,10,4,0,0 dcCreateText .97*x,.97*y,0,26 for j=1 to 31 x=-(90-decl(m(i)+j))*cos(((m(i)+j)*360/365+eot(m(i)+j)/4+100.375)*d2r) y=(90-decl(m(i)+j))*sin(((m(i)+j)*360/365+eot(m(i)+j)/4+100.375)*d2r) dcCreateCircle x,y,.4 next j next i mg=4.5 'Maximal magnitude of the shown stars (<=4.5) dcSetCircleParms dcBLACK,dcFILL,dcThin Open "STARS.DAT" For Input As #1 for i=1 to 900 Line Input #1, star ra(i)=Val(Mid(star,1,5)) de(i)=Val(Mid(star,9,6)) ma(i)=Val(Mid(star,17,5)) r=90-de(i) if r<=120 and (ma(i)<=mg or _ i=38 or i=72 or i=34 or i=233 or i=33 or i=79 or i=80 or _ i=70 or i=61 or i=86 or i=105 or i=247 or _ i=44 or i=820 or i=643 or i=727 or i=58 or i=178 or i=900) then x=r*cos(ra(i)*pi/12) y=-r*sin(ra(i)*pi/12) dcCreateCircle x,y,1.35-ma(i)/5 end if if i=38 then xx(1)=x:yy(1)=y 'Ursa Major if i=72 then xx(2)=x:yy(2)=y if i=34 then xx(3)=x:yy(3)=y if i=233 then xx(4)=x:yy(4)=y:xx(8)=x:yy(8)=y if i=33 then xx(5)=x:yy(5)=y if i=79 then xx(6)=x:yy(6)=y if i=80 then xx(7)=x:yy(7)=y if i=70 then xx(9)=x:yy(9)=y 'Cassiopea if i=61 then xx(10)=x:yy(10)=y if i=86 then xx(11)=x:yy(11)=y if i=105 then xx(12)=x:yy(12)=y if i=247 then xx(13)=x:yy(13)=y if i=44 then xx(14)=x:yy(14)=y 'Ursa Minor if i=820 then xx(15)=x:yy(15)=y if i=643 then xx(16)=x:yy(16)=y if i=727 then xx(17)=x:yy(17)=y:xx(21)=x:yy(21)=y if i=58 then xx(18)=x:yy(18)=y if i=178 then xx(19)=x:yy(19)=y if i=900 then xx(20)=x:yy(20)=y next i Close #1 ' Constellation lines dcSetLineParms dcBLACK, dcSOLID, dcNORMAL for i=1 to 7 'Ursa Major dcCreateLine xx(i),yy(i),xx(i+1),yy(i+1) next i for i=9 to 12 'Cassiopea dcCreateLine xx(i),yy(i),xx(i+1),yy(i+1) next i for i=14 to 20 'Ursa Minor dcCreateLine xx(i),yy(i),xx(i+1),yy(i+1) next i for i=-30 to 89 step 15 dcSetTextParms dcBlack, "Times New Roman","Standard",0,10,4,0,0 dcCreateText 0,-90+i,0," "+CStr(i) dcSetTextParms dcBlack, "Times New Roman","Standard",90,10,4,0,0 dcCreateText 90-i,0,0," "+CStr(i) dcSetTextParms dcBlack, "Times New Roman","Standard",180,10,4,0,0 dcCreateText 0,90-i,0," "+CStr(i) dcSetTextParms dcBlack, "Times New Roman","Standard",270,10,4,0,0 dcCreateText -90+i,0,0," "+CStr(i) next i for i=-30 to 89 if i=Int(i/5)*5 then dcCreateLine -90+i,1,-90+i,-1 dcCreateLine 1,90-i,-1,90-i dcCreateLine 90-i,-1,90-i,1 dcCreateLine -1,-90+i,1,-90+i else dcCreateLine -.5,-90+i,.5,-90+i dcCreateLine -90+i,.5,-90+i,-.5 dcCreateLine .5,90-i,-.5,90-i dcCreateLine 90-i,-.5,90-i,.5 end if next i dcAddLayer "Az-Ht-Dt" dcSetCurrentLayer "Az-Ht-Dt" dcSetTextParms dcBlack,"Times New Roman","Standard",180,10,21,0,0 dcCreateText 0,101,0,"Valentin Hristov E-mail: valhrist@bas.bg" dcCreateText 0,105,0,"Web page: www.math.bas.bg/complan/valnrist/mystuff.htm" lr=l*d2r dcSetCircleParms dcBlack,dcSolid,dcThin dcCreateCircle 0,0,3 dcCreateLine -3,0,3,0 dcCreateLine 0,-3,0,3 dcCreateCircle 0,0,120 dcCreateCircle 0,0,135 dcCreateCircle 0,0,150 dcSetTextParms dcBlue,"Times New Roman","Standard",180,14,5,0,0 dcCreateText 0,96,0,p dcSetTextParms dcBlue,"Times New Roman","Standard",135,14,5,0,0 dcCreateText 96*cos(pi/4),96*sin(pi/4),0,CStr(l)+" N" dcSetTextParms dcBlue,"Times New Roman","Standard",225,14,5,0,0 if lo<0 then dcCreateText 96*cos(3*pi/4),96*sin(3*pi/4),0,CStr(0-lo)+" W" else dcCreateText 96*cos(3*pi/4),96*sin(3*pi/4),0,CStr(lo)+" E" end if dcSetCircleParms dcRed,dcFill,dcThin for h=0 to 89 step 15 for a=0 to 180 hr=h*d2r ar=a*d2r sd=sin(hr)*sin(lr)-cos(hr)*cos(lr)*cos(ar) cd=Sqr(1-sd*sd) if cd<>0 then td=sd/cd dr=-Atn(td) d=dr*r2d ct=(cos(lr)*sin(hr)+sin(lr)*cos(hr)*cos(ar))/cd st=Sqr(1-ct*ct) else d=90 st=cos(hr)*sin(ar) ct=Sqr(1-st*st) end if if d<=30 then if a=int(a/5)*5 then dcCreateCircle (90+d)*st,-(90+d)*ct,.5 dcCreateCircle -(90+d)*st,-(90+d)*ct,.5 else dcCreateCircle (90+d)*st,-(90+d)*ct,.3 dcCreateCircle -(90+d)*st,-(90+d)*ct,.3 end if end if next a next h dcSetCircleParms dcDarkGreen,dcFill,dcThin for a=0 to 180 step 5 if a=int(a/45)*45 then he=90 else he=75 if a=int(a/15)*15 then stp=-1 else stp=-5 for h=he to 0 step stp hr=h*d2r ar=a*d2r sd=sin(hr)*sin(lr)-cos(hr)*cos(lr)*cos(ar) cd=Sqr(1-sd*sd) if cd<>0 then td=sd/cd dr=-Atn(td) d=dr*r2d ct=(cos(lr)*sin(hr)+sin(lr)*cos(hr)*cos(ar))/cd st=Sqr(1-ct*ct) if d<=30 then x=(90+d)*st y=-(90+d)*ct dcCreateCircle x,y,.3 dcCreateCircle -x,y,.3 if h=Int(h/5)*5 then dcCreateCircle x,y,.5 dcCreateCircle -x,y,.5 else dcCreateCircle x,y,.3 dcCreateCircle -x,y,.3 end if end if else dcCreateCircle 0,90-l,.3 end if next h if a<>Int(a/90)*90 and a=int(a/15)*15 then dcSetTextParms dcDarkGreen,"Times New Roman","Standard",90+Atn((y-l+90)/x)*r2d,10,5,0,0 dcCreateText x,y,0,CStr(180+a) dcSetTextParms dcDarkGreen,"Times New Roman","Standard",-90-Atn((y-l+90)/x)*r2d,10,5,0,0 dcCreateText -x,y,0,CStr(180-a) end if next a 'directions dcSetTextParms dcDarkGreen, "Times New Roman","Standard",0,30,21,0,0 if l>=60 then dcCreateText 0,-(180-l),0,"S" else dcCreateText 0,-120,0,"S" end if dcSetTextParms dcDarkGreen, "Times New Roman","Standard",180,30,21,0,0 dcCreateText 0,l,0,"N" dcSetTextParms dcDarkGreen, "Times New Roman","Standard",180-l,30,21,0,0 dcCreateText 90,0,0,"W" dcSetTextParms dcDarkGreen, "Times New Roman","Standard",180+l,30,21,0,0 dcCreateText -90,0,0,"E" 'outer date scale ll=10.375+lo-cm-(cm+7.5)/360*0.985647 dcSetLineParms dcBlack, dcSOLID, dcThin for i=0 to 364 ' date marks x=135*cos((i+ll)*2*pi/365) y=135*sin((i+ll)*2*pi/365) dcCreateLine x,y,1.02*x,1.02*y next i for i=1 to 12 x=135*cos((m(i)+ll)*2*pi/365) y=135*sin((m(i)+ll)*2*pi/365) dcCreateLine x,y,1.05*x,1.05*y ' 1-st of the month dcSetTextParms dcBlack, "Times New Roman","Bold",90+ll+m(i)*360/365,12,4,0,0 dcCreateText x*1.08,y*1.08,0,mm(i) x=135*cos((m(i)+ll+5)*2*pi/365) ' 6-th of the month y=135*sin((m(i)+ll+5)*2*pi/365) dcCreateLine x,y,1.04*x,1.04*y dcSetTextParms dcBlack, "Times New Roman","Standard",90+ll+(m(i)+5)*360/365,10,4,0,0 dcCreateText x*1.06,y*1.06,0,"6" x=135*cos((m(i)+ll+10)*2*pi/365) ' 11-th of the month y=135*sin((m(i)+ll+10)*2*pi/365) dcCreateLine x,y,1.04*x,1.04*y dcSetTextParms dcBlack, "Times New Roman","Standard",90+ll+(m(i)+10)*360/365,10,4,0,0 dcCreateText x*1.06,y*1.06,0,"11" x=135*cos((m(i)+ll+15)*2*pi/365) ' 16-th of the month y=135*sin((m(i)+ll+15)*2*pi/365) dcCreateLine x,y,1.04*x,1.04*y dcSetTextParms dcBlack, "Times New Roman","Standard",90+ll+(m(i)+15)*360/365,10,4,0,0 dcCreateText x*1.06,y*1.06,0,"16" x=135*cos((m(i)+ll+20)*2*pi/365) ' 21-th of the month y=135*sin((m(i)+ll+20)*2*pi/365) dcCreateLine x,y,1.04*x,1.04*y dcSetTextParms dcBlack, "Times New Roman","Standard",90+ll+(m(i)+20)*360/365,10,4,0,0 dcCreateText x*1.06,y*1.06,0,"21" x=135*cos((m(i)+ll+25)*2*pi/365) ' 26-st of the month y=135*sin((m(i)+ll+25)*2*pi/365) dcCreateLine x,y,1.04*x,1.04*y dcSetTextParms dcBlack, "Times New Roman","Standard",90+ll+(m(i)+25)*360/365,10,4,0,0 dcCreateText x*1.06,y*1.06,0,"26" next i dcSetTextParms dcRed,"Times New Roman","Standard",180,10,6,0,0 for i=0 to 90 step 15 dcCreateText 0,l-i,0,CStr(i)+" " next i Sub Initial_Data Begin Dialog CONSTANTS_INPUT 13,1,200,97,"Initial data" Text 15,0,300,10, "STAR AND SUN CLOCK (NORTHERN HEMISPHERE)" Text 15,8,150,10, "with standard and daylight savings time" Text 15,16,150,10, "and correction for the longitude" Text 15,28,150,10, "Location" Text 15,40,150,10, "Latitude (decimal degrees, ONLY >0)" Text 15,52,150,10, "Longitude (decimal degrees, E is >0)" Text 15,64,150,10, "Central meridian of the time zone" TextBox 88,28,99,10, .p TextBox 150,40,37,10, .l TextBox 150,52,37,10, .lo TextBox 150,64,37,10, .cm OKButton 82,82,37,12 End Dialog Dim prompt As CONSTANTS_INPUT prompt.p = "Lozen-Sofia" prompt.l = 42.6021 prompt.lo = 23.5011 prompt.cm = 30 repeat_until_inputcorrect: 'label to return if input is not correct action = Dialog(prompt) 'get the input If test("latitude",prompt.l,0,90) = false Then GoTo repeat_until_inputcorrect End If If test("longitude",prompt.lo,-180,180) = false Then GoTo repeat_until_inputcorrect End If If test("central meridian",prompt.cm,-180,180) = false Then GoTo repeat_until_inputcorrect End If p = prompt.p l = prompt.l lo = prompt.lo cm = prompt.cm End Sub 'Initial_Data 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