' ***************************************************************************** ' *** *** ' *** A nomogram builder macro for DeltaCAD *** ' *** *** ' *** in conversational mode as opposed to the more modern object *** ' *** oriented mode, but with notes. Page numbers refer to Manual.pdf *** ' *** Or Basic.pdf provided with Deltacad *** ' *** *** ' ***************************************************************************** Sub Main() ' main procedure is required ' ***************************************************************************** ' Initial house keeping - clear the screen - set the drafting area unit ' ***************************************************************************** ' select all objects that may exist on the screen then erase them all If (dcSelectAll) Then dcEraseSelObjs End If ' NOTE: Works on Vista ' Nomogram logic started Sept 7, 2009 ' Memory usage improved, circular nomogram added Sept 28. 2009 ' Circular dial nomogram refined by adding more info refined Oct 1, 2009 ' Analemmatic dial choice 9 done October 5 ' Clarifying note in choice 3 October 20, 2009 ' AUTHOR:Simon Wheaton-Smith ' ***************************************************************************** ' A generic definition is required for a screen input area ' ***************************************************************************** Begin Dialog aaaaa 20, 20, 350,220, "NOMOGRAM builder: ||| ~ N or Z ~ (|) nomograms: October 20, 2009" TextBox 5, 5, 15, 10, .mychc Text 25, 5, 100,10, "Enter kind of nomogram" Text 25, 15, 120,10, "1. Horizontal dial" Text 25, 25, 250,10, "11 Horizontal dial: (|) circular version [15 min increments]" Text 25, 35, 250,10, "111 Horizontal dial: (|) circular version [5 min increments]" Text 25, 45, 120,10, "2. Vertical dial" Text 25, 55, 180,10, "3. Horizontal and Vertical dial together" Text 25, 65, 180,10, "4. Sunrise and Sunset" Text 25, 75, 180,10, "44. Sunrise and Sunset (based on q-dial)" Text 25, 85, 210,10, "5. Polar and Meridian dial with calendar data: | | | version" Text 25, 95, 210,10, "55 Polar and Meridian dial with calendar data: N or Z version" Text 25,105, 180,10, "6. vdec SD data and..." Text 25,115, 180,10, "7. vdec SH data and..." Text 25,125, 180,10, "8. vdec DL data or..." Text 25,135, 180,10, "88 vdec DL xL xC xR mR " TextBox 80,135, 20, 10, .myxL TextBox 115,135, 20, 10, .myxC TextBox 150,135, 20, 10, .myxR TextBox 190,135, 20, 10, .mymR Text 25,145, 180,10, "9. Analemmatic dial X and Y by hour and latitude" Text 25,155, 180,10, "99. Analemmatic dial declination point on N:S" OKButton 5,170, 40, 10 CancelButton 75,170, 40, 10 Text 5,185, 300, 40, "Program may end in BASIC SCRIPT ERROR. Ignore BASIC SCRIPT ERROR message." Text 5,195, 180, 40, "www.illustratingshadows.com" Text 100,205, 340, 40, "/stats-nomogram.html ...and... /nomogram.pdf" End Dialog ' ***************************************************************************** ' The generic definition must then be generated with a name ' ***************************************************************************** ' ' this defines "bbbbb" as an instance of aaaaa dialog Dim bbbbb As aaaaa ' choice 9 uses the fllowing bbbbb.myxL = -0.5 bbbbb.myxC = 0 bbbbb.myxR = 0.5 bbbbb.mymr = 0.55 Dim chc As Single bbbbb.mychc = "3" ' here the dialog is invoked and the button results returned to ccccc ccccc = Dialog(bbbbb) ' which causes the answer to be returned chc = bbbbb.mychc ' CANCEL button returns 0 ' OK button returns -1 ' you can determine the button with - Print ccccc, lat, lng, ref ' ***************************************************************************** ' *** ok, what was returned? if ok then do the program itself *** ' ***************************************************************************** If chc = 1 Then ' ************************************************************************** ' *** horizontal dial nomogram itself *** ' ************************************************************************** ' *** Set X coordinates ' X = -1 latitude ' X = 0 resulting hour line angle ' X = +1 hour angle of the sun Dim xl, xr, xc As Single Dim x As Single xl = -1 xc = 0 xr = 1 ' set the text color, font, size, etc also dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 dcSetLineParms dcBLUE,dcSOLID,dcTHIN ' *** A type 1 nomogram with equidistant lines ' DeltaCAD has no log base 10 so this uses natural logs ' *** LATITUDE line is on the left dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 Dim lat As Single For lat = 10 To 80 Step 2 ' save y low and high values y = Log(Sin(lat*2*3.1416/360)) If lat = 10 Then ylo = y Else yhi = y End If ' draw a marker line ' but only say number if 10 multiple If (lat/10 - Int(lat/10)) = 0 Then dcCreateText xl , y, 0, Format(lat, "00.0") dcSetLineParms dcBLACK,dcSOLID,dcTHIN dcCreateLine xl, y, xl-0.3, y Else dcCreateLine xl, y, xl-0.1, y End If Next lat dcCreateLine xl, ylo, xl, yhi dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 dcCreateText xl-0.5 , yhi+0.1, 0, "Latitude 2 degree increments" ' *** HOUR ANGLE i.e. TIME of the sun line is on the right dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 Dim hr As Single For hr = 0.25 To 5.75 Step 0.25 ' save y low and high values y = Log(Tan(15*hr*2*3.1416/360)) If hr = 0.25 Then ylo = y Else yhi = y End If ' draw a marker line ' but only say number if 10 multiple If (hr - Int(hr)) = 0 Then dcCreateText xr-0.15 , y, 0, Format(hr, "00.00") dcSetLineParms dcBLACK,dcSOLID,dcTHIN dcCreateLine xr, y, xr+0.3, y Else dcCreateLine xr, y, xr+0.1, y End If Next hr dcCreateLine xr, ylo, xr, yhi dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 dcCreateText xr-1 , yhi+0.1, 0, "Hour from noon in 15 minute increments" ' *** HOUR LINE ANGLE of the dial plate's hour lines, in the center dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 Dim hla As Single For hla = 1 To 80 Step 1 ' save y low and high values ' but mid scale is 0.5 of actual y = 0.5 * Log(Tan(hla*2*3.1416/360)) If hla = 1 Then ylo = y Else yhi = y End If ' draw a marker line ' but only say number if 10 multiple If (hla/10 - Int(hla/10)) = 0 Then dcCreateText xc-0.15 , y, 0, Format(hla, "00") dcSetLineParms dcBLACK,dcSOLID,dcTHIN dcCreateLine xc, y, xc+0.3, y Else dcCreateLine xc, y, xc+0.1, y End If Next hr dcCreateLine xc, ylo, xc, yhi dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 dcCreateText xc-1 , yhi+0.1, 0, "Hour line angle in 1 degree increments" dcCreateText xc-1 , ylo-0.1, 0, "HORIZONTAL DIAL www.illustratingshadows.com" dcCreateText xc-1 , ylo-0.2, 0, "lat is log sin lat so scale decreases" dcCreateText xc-1 , ylo-0.3, 0, "lng and hla is log tan so scale decreases then increases" End If ' choice 1 as type 3 - circular - 15 min intervals If chc = 11 Then choice11 (11) End If ' choice 1 as type 3 - circular - 1 min intervals If chc = 111 Then choice11 (111) End If If chc = 2 Then ' ************************************************************************** ' *** vertical dial nomogram itself *** ' ************************************************************************** ' line color is 0 is black ' line type is dcsolid ' line weight is dcnormal ' *** Set X coordinates ' X = -1 latitude ' X = 0 resulting hour line angle ' X = +1 hour angle of the sun xl = -1 xc = 0 xr = 1 ' set the text color, font, size, etc also dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 dcSetLineParms dcBLUE,dcSOLID,dcTHIN ' *** A type 1 nomogram with equidistant lines ' DeltaCAD has no log base 10 so this uses natural logs ' *** LATITUDE line is on the left dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 For lat = 10 To 80 Step 2 ' save y low and high values y = Log(Cos(lat*2*3.1416/360)) If lat = 10 Then ylo = y Else yhi = y End If ' draw a marker line ' but only say number if 10 multiple If (lat/10 - Int(lat/10)) = 0 Then dcCreateText xl , y, 0, Format(lat, "00.0") dcSetLineParms dcBLACK,dcSOLID,dcTHIN dcCreateLine xl, y, xl-0.3, y Else dcCreateLine xl, y, xl-0.1, y End If Next lat dcCreateLine xl, ylo, xl, yhi dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 dcCreateText xl-0.5 , ylo+0.1, 0, "Latitude 2 degree increments" ' *** HOUR ANGLE i.e. TIME of the sun line is on the right dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 For hr = 0.25 To 5.75 Step 0.25 ' save y low and high values y = Log(Tan(15*hr*2*3.1416/360)) If hr = 0.25 Then ylo = y Else yhi = y End If ' draw a marker line ' but only say number if 10 multiple If (hr - Int(hr)) = 0 Then dcCreateText xr-0.15 , y, 0, Format(hr, "00.00") dcSetLineParms dcBLACK,dcSOLID,dcTHIN dcCreateLine xr, y, xr+0.3, y Else dcCreateLine xr, y, xr+0.1, y End If Next hr dcCreateLine xr, ylo, xr, yhi dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 dcCreateText xr-1 , yhi+0.1, 0, "Hour from noon in 15 minute increments" ' *** HOUR LINE ANGLE of the dial plate's hour lines, in the center dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 For hla = 1 To 80 Step 1 ' save y low and high values ' but mid scale is 0.5 of actual y = 0.5 * Log(Tan(hla*2*3.1416/360)) If hla = 1 Then ylo = y Else yhi = y End If ' draw a marker line ' but only say number if 10 multiple If (hla/10 - Int(hla/10)) = 0 Then dcCreateText xc-0.15 , y, 0, Format(hla, "00") dcSetLineParms dcBLACK,dcSOLID,dcTHIN dcCreateLine xc, y, xc+0.3, y Else dcCreateLine xc, y, xc+0.1, y End If Next hr dcCreateLine xc, ylo, xc, yhi dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 dcCreateText xc-1 , yhi+0.1, 0, "Hour line angle in 1 degree increments" dcCreateText xc-1 , ylo-0.1, 0, "VERTICAL DIAL www.illustratingshadows.com" dcCreateText xc-1 , ylo-0.2, 0, "lat is log sin lat so scale decreases" dcCreateText xc-1 , ylo-0.3, 0, "lng and hla is log tan so scale decreases then increases" End If If chc = 3 Then ' ************************************************************************** ' *** vertical and horizontal dial merged dial nomogram itself *** ' ************************************************************************** ' line color is 0 is black ' line type is dcsolid ' line weight is dcnormal ' *** Set X coordinates ' X = -1 latitude ' X = 0 resulting hour line angle ' X = +1 hour angle of the sun xl = -1 xc = 0 xr = 1 ' set the text color, font, size, etc also dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 dcSetLineParms dcBLUE,dcSOLID,dcTHIN ' *** A type 1 nomogram with equidistant lines ' DeltaCAD has no log base 10 so this uses natural logs ' *** LATITUDE line is on the left VERTICAL DIAL dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 xl = xl -0.5 For lat = 10 To 80 Step 2 If (90-lat) < 30 Then dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 End If ' save y low and high values y = Log(Sin(lat*2*3.1416/360)) ' = Log(Cos(lat*2*3.1416/360)) ' could have done this (see 90-Lat below) If lat = 10 Then ylo = y Else yhi = y End If ' draw a marker line ' but only say number if 10 multiple If (lat/10 - Int(lat/10)) = 0 Then dcCreateText xl , y, 0, Format(90-lat, "00") ' dcCreateText xl , y, 0, Format(lat, "00.0") ' if we did cos(lat) see above dcSetLineParms dcBLACK,dcSOLID,dcTHIN dcCreateLine xl, y, xl-0.3, y Else dcCreateLine xl, y, xl-0.1, y End If Next lat ' dcCreateLine xl, ylo, xl, yhi dcSetTextParms dcBLACK,"Ariel","Bold",0,8, 20,0,0 dcCreateText xl+0.3 , yhi+0.2, 0, "Latitude" dcCreateText xl-0.2 , ylo-0.1, 0, "V-dial" dcCreateText xl-0.3 , ylo-0.3, 0, "For v-dial, use the" dcCreateText xl-0.3 , ylo-0.4, 0, "h-dial vertical line" dcCreateText xl-0.3 , ylo-0.5, 0, "for marking latitude" ' go back and do 1 degree lne for wider spaced latitudes For lat = 10 To 50 Step 1 ' draw a 1 degree marker lins for lower latitudes y = Log(Sin(lat*2*3.1416/360)) dcCreateLine xl, y, xl-0.1, y Next lat ' *** LATITUDE line is on the left some more for Horizontal dial xl = xl +0.5 For lat = 10 To 80 Step 2 dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 If (lat) > 60 Then dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 End If ' save y low and high values y = Log(Sin(lat*2*3.1416/360)) If lat = 10 Then ylo = y Else yhi = y End If ' draw a marker line ' but only say number if 10 multiple If (lat/10 - Int(lat/10)) = 0 Then dcCreateText xl , y, 0, Format(lat, "00") dcSetLineParms dcBLACK,dcSOLID,dcTHIN dcCreateLine xl, y, xl-0.3, y Else dcCreateLine xl, y, xl-0.1, y End If Next lat dcSetTextParms dcBLACK,"Ariel","Bold",0,8, 20,0,0 dcCreateLine xl, ylo, xl, yhi dcCreateText xl-0.2 , ylo-0.1, 0, "H-dial" xl = xl +0.5 ' go back and do 1 degree line for wider spaced latitudes xl = xl -0.5 For lat = 10 To 50 Step 1 ' draw a 1 degree marker lins for lower latitudes y = Log(Sin(lat*2*3.1416/360)) dcCreateLine xl, y, xl-0.1, y Next lat ' *** SUN'S HOUR ANGLE i.e. TIME of the sun line is on the right dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 For hr = 0.25 To 5.75 Step 0.25 ' save y low and high values y = Log(Tan(15*hr*2*3.1416/360)) If hr = 0.25 Then ylo = y Else yhi = y End If ' draw a marker line ' but only say number if 10 multiple If (hr - Int(hr)) = 0 Then dcCreateText xr-0.25 , y, 0, Format(12-hr, "00.00") dcCreateText xr+0.35 , y, 0, Format( hr, "00.00") dcSetLineParms dcBLACK,dcSOLID,dcTHIN dcCreateLine xr, y, xr+0.3, y Else dcCreateLine xr, y, xr+0.1, y End If Next hr dcCreateLine xr, ylo, xr, yhi dcSetTextParms dcBLACK,"Ariel","Bold",0,8, 20,0,0 dcCreateText xr-0.4, yhi+0.2, 0, "Hour around noon" dcCreateText xr-0.2 , yhi , 0, "AM" dcCreateText xr+0.2 , yhi , 0, "PM" ' *** HOUR LINE ANGLE of the dial plate's hour lines, in the center dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 For hla = 1 To 80 Step 1 ' save y low and high values ' but mid scale is 0.5 of actual y = 0.5 * Log(Tan(hla*2*3.1416/360)) If hla = 1 Then ylo = y Else yhi = y End If ' draw a marker line ' but only say number if 10 multiple If (hla/10 - Int(hla/10)) = 0 Then dcCreateText xc-0.15 , y, 0, Format(hla, "00") dcSetLineParms dcBLACK,dcSOLID,dcTHIN dcCreateLine xc, y, xc+0.3, y Else dcCreateLine xc, y, xc+0.1, y End If Next hr dcCreateLine xc, ylo, xc, yhi dcSetTextParms dcBLACK,"Ariel","Bold",0,8, 20,0,0 dcCreateText xc-1 , yhi+0.2, 0, "Dial Plate's hour line angle" dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 dcCreateText xl+0.3 , ylo-0.1, 0, "Horizontal and Vertical dial plate" dcCreateText xl+0.3 , ylo-0.2, 0, "www.illustratingshadows.com" dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 dcCreateText xl+0.3 , ylo-0.4, 0, "latitude is log(sin(lat)) so scale decreases vertically" dcCreateText xl+0.3 , ylo-0.5, 0, "longitude is log(tan(lng)) so scale decreases first then increases" dcCreateText xl+0.3 , ylo-0.6, 0, "hour line angle is log(tan(hla)) so scale decreases first then increases" dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 dcCreateText xl-0.2 , yhi+1.0, 0, "First, mark latitude on the left vertical line" dcCreateText xl-0.2 , yhi+0.9, 0, "Next, mark the desired time on the right vertical line" dcCreateText xl-0.2 , yhi+0.8, 0, "Then, read hour line angle on the center vertical line" dcCreateBox xl-0.3 , yhi+0.7, xl+1.7, yhi+1.1 ' left bottom, right, top End If If chc = 4 Then ' ************************************************************************** ' *** sunset and sunrise nomogram itself *** ' ************************************************************************** ' *** Set X coordinates ' X = -1 latitude ' X = 0 resulting hour line angle ' X = +1 hour angle of the sun xl = -1 xc = 0 xr = 1 ' set the text color, font, size, etc also dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 dcSetLineParms dcBLACK,dcSOLID,dcTHIN ' *** LATITUDE line is on the left dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 For lat = 1 To 60 Step 1 ' save y low and high values y = Log(Tan(lat*2*3.1416/360)) If lat = 1 Then ylo = y Else yhi = y End If ' draw a marker line ' but only say number if 10 multiple If (lat/10 - Int(lat/10)) = 0 Then dcCreateText xl , y, 0, Format(lat, "00") dcSetLineParms dcBLACK,dcSOLID,dcTHIN dcCreateLine xl, y, xl-0.3, y Else dcCreateLine xl, y, xl-0.1, y End If Next lat dcCreateLine xl, ylo, xl, yhi dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 dcCreateText xl-0.3 , yhi+0.1, 0, "LATITUDE" dcCreateText xc-0.4, yhi+0.2, 0, "SUNRISE/SET NOMOGRAM www.illustratingshadows.com" dcCreateText xc-0.4, yhi+0.1, 0, "1. The EOT must be added to correct the times" dcCreateText xc-0.4, yhi+0.0, 0, "2. If west of meridian, add 4*long diff" dcCreateText xc-0.4, yhi-0.1, 0, " If east of meridian, subtract 4*long diff" ' *** HOUR ANGLE i.e. TIME of the sun line is in the middle ' ' hsr = arccos( tan(lat) * tan(decl) ) ' ' cos(hsr) = tan(lat) * tan(decl) ' ' ' dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 For hr = 0.25 To 5.75 Step 0.25 ' save y low and high values y = 0.5* Log(Cos(15*hr*2*3.1416/360)) If hr = 0.25 Then ylo = y Else yhi = y End If ' draw a marker line ' but only say number if 10 multiple If (hr - Int(hr)) = 0 Then dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 dcCreateText xc-0.15 , y, 0, Format(12-hr, "00.00") dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 dcCreateText xc-0.3 , y, 0, Format(hr, "00.00") dcSetLineParms dcBLACK,dcSOLID,dcTHIN dcCreateLine xc, y, xc+0.3, y Else dcCreateLine xc, y, xc+0.1, y End If Next hr ' do one minute incremente at the bottom dcCreateText xc-0.4 , yhi+0.05, 0, "above 15 min" dcCreateText xc-0.4 , yhi-0.05, 0, "below 1 min" For hr = 5.75 To (5+60/60) Step 1/60 ' save y low and high values y = 0.5* Log(Cos(15*hr*2*3.1416/360)) If hr = 0.25 Then ylo = y Else yhi = y End If ' draw a marker line dcCreateLine xc, y, xc+0.035, y Next hr dcCreateLine xc, ylo, xc, yhi dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 dcCreateText xc-0.4, ylo+0.15, 0, "SUNRISE TIME A.M." dcCreateText xc-0.4 , ylo+0.07, 0, "Summer" dcCreateText xc-0.0 , ylo+0.07, 0, "Winter" dcCreateText xc-0.4 , yhi-0.1, 0, "Winter" dcCreateText xc-0.0 , yhi-0.1, 0, "Summer" dcCreateText xc-0.4, yhi-0.18, 0, "SUNSET TIME P.M." ' *** SOLAR DECLINATION of the dial plate's hour lines on the right dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 ' winter For decl = 1 To 24 Step 1 ' save y low and high values ' but mid scale is 0.5 of actual y = Log(Tan(decl*2*3.1416/360)) If decl = 1 Then ylo = y Else yhi = y End If ' draw a marker line ' but only say number if 10 multiple If (hla/10 - Int(hla/10)) = 0 Then dcCreateText xr-0.15 , y, 0, Format( decl, "00") dcSetLineParms dcBLACK,dcSOLID,dcTHIN dcCreateLine xr, y, xr+0.3, y Else dcCreateLine xr, y, xr+0.1, y End If Next hr ' *** SOLAR DECLINATION of the dial plate's hour lines on the right - continued dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 dcCreateText xr-0.5 , yhi+0.22 , 0, "SOLAR DECLINATION" dcCreateText xr-0.5 , yhi+0.14 , 0, "SOLSTICE" dcCreateText xr-0.5 , yhi+0.06 , 0, "JUNE & DECEMBER" dcCreateText xr-0.5 , ylo-0.1 , 0, "EQUINOX is below at 0 degrees" dcCreateText xr-0.5 , ylo-0.18 , 0, "MARCH & SEPTEMBER" ' *** SOLAR DECLINATION of the dial plate's hour lines on the right - continued dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 dcCreateLine xr, ylo, xr, yhi dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 ' *** show EOT and DECL for the dial plate eotDecl End If If chc = 44 Then choice44 End If If chc = 5 Then ' ************************************************************************** ' *** Polar or meridian true east/west dial figures *** ' ************************************************************************** ' distance up an hour line to calendar pt = tan (declination) / cos (time ) ' *** Set X coordinates ' X = -1 latitude ' X = 0 resulting hour line angle ' X = +1 hour angle of the sun xl = -1 xc = 0 xr = 1 ' set the text color, font, size, etc also dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 dcSetLineParms dcBLACK,dcSOLID,dcTHIN ' *** 1/cos(lha) TIME line is on the left dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 For hr = 0 To 5.5 Step 0.25 ' save y low and high values y = Log(1/Cos(15*hr*2*3.1416/360)) If hr = 0 Then ylo = y Else yhi = y End If ' draw a marker line ' but only say number if 10 multiple If (hr - Int(hr)) = 0 Then dcCreateText xl+0.1 , y, 0, Format(hr, "#0") ' NOTE: This is the 1/cos line but we show tan(hr) as it is a SOLUTION dcCreateText xl-0.5, y, 0, Format(Tan(15*hr*2*3.1416/360), "#0.000") dcSetLineParms dcBLACK,dcSOLID,dcTHIN dcCreateLine xl, y, xl-0.3, y Else dcCreateLine xl, y, xl-0.1, y End If Next hr dcCreateLine xl, ylo, xl, yhi dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 dcCreateText xl-0.5 , yhi+0.1, 0, "LOCAL TIME FROM TRANSIT" dcCreateText xl-0.5 , ylo-0.1, 0, "DIST TO HR.LN" dcSetTextParms dcBLACK,"Ariel","Bold",0,10, 20,0,0 dcCreateText xl-0.5 , ylo-0.25, 0, "ANSWER 1" dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 dcCreateText xl+0.1 , yhi-0.1, 0, "Hr" dcCreateText xc-0.4, yhi , 0, "POLAR (and meridian E/W) DIAL www.illustratingshadows.com" dcCreateText xc-0.4, yhi-0.1, 0, "1. The EOT must be added to correct the times" dcCreateText xc-0.4, yhi-0.2, 0, "2. If west of meridian, add 4*long diff" dcCreateText xc-0.4, yhi-0.3, 0, " If east of meridian, subtract 4*long diff" dcCreateText xc-0.4, yhi-0.4, 0, "Assumes a style linear height of 1.0" dcCreateText xc-0.4, yhi-0.5, 0, "Draw line from hour to declination, read (1) HR LINE DIST" dcCreateText xc-0.4, yhi-0.6, 0, "as well as (2) distance on hour line to calendar point" ' *** DISTANCE ON HOUR LINE FOR THIS DECL's CALENDAR POINT ' ' decpt = tan(decl) * 1/cos(time) ' ' log decpt = log tan(decl) + log (1/cos(time)) ' dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 Dim decpt As Single For decpt = 1 To 60.0 Step 1 ' save y low and high values y = 0.5 * Log(decpt/10) If decpt = 1 Then ylo = y Else yhi = y End If ' draw a marker line but only say number if integer If (decpt/10 - Int(decpt/10)) = 0 Then dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 dcCreateText xc-0.1 , y, 0, Format(decpt/10, "#0") dcSetLineParms dcBLACK,dcSOLID,dcTHIN dcCreateLine xc, y, xc+0.3, y ElseIf decpt <10 Then dcCreateLine xc, y, xc+0.1, y dcCreateText xc-0.1 , y, 0, Format(decpt/10, "0.0") Else dcCreateLine xc, y, xc+0.1, y End If Next decpt dcCreateLine xc, ylo, xc, yhi dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 dcCreateText xc-0.3 , ylo-0.1, 0, "CAL PT DISTANCE" dcCreateText xc-0.3 , ylo-0.2, 0, "0.1 to 6" dcSetTextParms dcBLACK,"Ariel","Bold",0,10, 20,0,0 dcCreateText xc-0.3 , ylo-0.35, 0, "ANSWER 2" dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 ' *** SOLAR DECLINATION of the dial plate's hour lines on the right dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 ' winter For decl = 1 To 24 Step 1 ' save y low and high values ' but mid scale is 0.5 of actual y = Log(Tan(decl*2*3.1416/360)) If decl = 1 Then ylo = y Else yhi = y End If ' draw a marker line ' but only say number if 10 multiple If (decl/10 - Int(decl/10)) = 0 Then dcCreateText xr-0.15 , y, 0, Format( decl, "#0") dcSetLineParms dcBLACK,dcSOLID,dcTHIN dcCreateLine xr, y, xr+0.3, y Else dcCreateText xr-0.15 , y, 0, Format( decl, "#0") dcCreateLine xr, y, xr+0.1, y End If Next hr ' *** SOLAR DECLINATION of the dial plate's hour lines on the right - continued dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 dcCreateText xr-0.5 , yhi+0.22 , 0, "SOLAR DECLINATION" dcCreateText xr-0.5 , yhi+0.14 , 0, "SOLSTICE" dcCreateText xr-0.5 , yhi+0.06 , 0, "JUNE & DECEMBER" dcCreateText xr-0.5 , ylo-0.1 , 0, "EQUINOX is below at 0 degrees" dcCreateText xr-0.5 , ylo-0.18 , 0, "MARCH & SEPTEMBER" ' *** SOLAR DECLINATION of the dial plate's hour lines on the right - continued dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 dcCreateLine xr, ylo, xr, yhi dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 ' *** show EOT and DECL for the dial plate eotDecl End If If chc = 55 Then choice55 End If If chc = 6 Then choice6 End If If chc = 7 Then choice7 End If If chc = 8 Then choice8 End If If chc = 88 Then ' ************************************************************************** ' *** DL difference in longitude = -(Atn(Tan(dec)/Sin(lat)))-(lng-ref) *** ' *** *** ' *** same as choice 8 except you can alter xL, xR, and XC positions *** ' *** set the right scale's modulus *** ' *** to get the best display *** ' *** *** ' ************************************************************************** ' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ' Dim ml, mr, mc As Single Dim a, b As Single ' ' *** Set X coordinates which sets the left and right distances from center ' xl = -1 xc = 0 xr = 0.8 ' ' *** Set RIGHT modulus (scale) which sets "mL", "mC" set the stage ' mr = 0.5 ' /////////////////////////////////////////////////////////// xL = bbbbb.myxL ' xC = bbbbb.myxC ' from the dialog xR = bbbbb.myxR ' box mR = bbbbb.mymr ' ' //////////////////////////////////////////////////////////// ' ' *** Set drawing parameters ' dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 dcSetLineParms dcBLACK,dcSOLID,dcTHIN ' ' *** this causes the modulus to be reset for the scales in the next block of code ' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ' derive the scale of the central scale from the other two. ' "m" means the scale or modulus. ' "a" is the left to center distance ' "b" is the center to right distance ' mL is the scale factor of the left scale, mR of the right, and mC of the center ' ' mL / mR = a / b and mC = mLmR / (mL+ mR) ' ' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ' ' first get the two distances separating the three lines ' a = Abs(xl)-Abs(xc) b = Abs(xr)-Abs(xc) ' ' now derive ml ' ml = Abs(mr) * a / b mc = ml*mr / (ml+mr) ' ' dcCreateText xl-1.5, 0.5, 0, "ml = "+Format(ml, "#0.0") ' ' . . . ' ' dcCreateText xl-1.5, 0.1, 0, "b = "+Format(b , "#0.0") ' ' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ' *** 1/sin(lat) LATITUDE line is on the left For lat = 10 To 80 Step 1 ' save y low and high values y = mL * Log(1/Sin(lat*2*3.1416/360)) If lat = 10 Then ylo = y Else yhi = y End If ' draw a marker line ' but only say number if 10 multiple If (lat/10 - Int(lat/10)) = 0 Then dcCreateText xl+0.1 , y, 0, Format(lat, "#0") dcCreateLine xl, y, xl-0.3, y Else dcCreateLine xl, y, xl-0.1, y End If Next hr dcCreateLine xl, ylo, xl, yhi dcCreateText xl-0.5 , ylo+0.1, 0, "LATITUDE" dcCreateText xl-0.5 , yhi-0.1, 0, "LATITUDE" ' *** DL difference in longitude For decpt = 1 To 60 Step 1 ' save y low and high values y = mC * Log(Tan(2*3.1416*decpt/360)) If decpt = 1 Then ylo = y Else yhi = y End If ' draw a marker line but only say number if integer If (decpt/10 - Int(decpt/10)) = 0 Then dcCreateText xc-0.1 , y, 0, Format(decpt , "#0") dcCreateLine xc, y, xc+0.3, y ElseIf decpt <5 Then dcCreateLine xc, y, xc+0.1, y dcCreateText xc-0.1 , y, 0, Format(decpt , "0") Else dcCreateLine xc, y, xc+0.1, y End If Next decpt dcCreateLine xc, ylo, xc, yhi dcCreateText xc-0.8 , ylo , 0, "DL angle" dcCreateText xc-0.8 , ylo-0.2, 0, "DL difference in longitude" ' *** ADVISE what the nomogram parameters were dcCreateText xc-0.8, ylo-0.4, 0, "Nomogram Design Parameters (=> means derived)" dcCreateText xc-0.8, ylo-0.5, 0, "ml => "+Format(ml, "#0.00") dcCreateText xc-0.8, ylo-0.6, 0, "mc => "+Format(mc, "#0.00") dcCreateText xc-0.8, ylo-0.7, 0, "mr = "+Format(mr, "#0.00") dcCreateText xc-0.8, ylo-0.8, 0, "a => "+Format(a , "#0.00") dcCreateText xc-0.8, ylo-0.9, 0, "b => "+Format(b , "#0.00") dcCreateText xc-0.8, ylo-1.0, 0, "xl = "+Format(xl, "#0.00") dcCreateText xc-0.8, ylo-1.1, 0, "xc = "+Format(xc, "#0.00") dcCreateText xc-0.8, ylo-1.2, 0, "xr = "+Format(xr, "#0.00") ' *** WALL DECLINATION of the dial plate line on the right For decl = 1 To 60 Step 1 ' save y low and high values ' but mid scale is 0.5 of actual y = mR * Log(Tan(decl*2*3.1416/360)) If decl = 1 Then ylo = y Else yhi = y End If ' draw a marker line ' but only say number if 10 multiple If (decl/10 - Int(decl/10)) = 0 Then dcCreateText xr-0.15 , y, 0, Format( decl, "#0") dcCreateLine xr, y, xr+0.3, y Else dcCreateLine xr, y, xr+0.1, y If decl < 10 Then dcCreateText xr-0.15 , y, 0, Format( decl, "#0") End If End If Next hr dcCreateText xr , yhi+0.1 , 0, "WALL DECLINATION" dcCreateLine xr, ylo, xr, yhi End If If chc = 9 Then choice9 End If If chc = 99 Then choice99 End If ' ***************************************************************************** ' *** this ends the entire program *** ' ***************************************************************************** End Sub ' ***************************************************************************** ' *** MAIN PROGRAM FUNCTIONS AS FUNCTIONS TO CONSERVE MEMORY *** ' ***************************************************************************** ' ************************************************************************** ' *** *** ' *** 11 is choice 1 but as a CIRCLE nomogram *** ' *** choice 111 is the time in 1 minute not 15 m intervals *** ' *** *** ' ************************************************************************** Function choice11 ( chc As Single ) ' ******************************** ' * circular nomogram key points * ' ******************************** Dim S As Single ' S ~ ~ ~ ~ ~ ~ the scale multiplier S = 3 ' *** Set X coordinates Dim bigX As Single xl = -1 'xc = xL + S/2 'xr = xC + S/2 ' *** Set Y coordinates Dim yDisp As Single yDisp = 0 ' ******************************** ' * circular nomograms * ' ******************************** ' xL ~ ~ ~ ~ ~ ~ the focal point of all scales for a circular nomogram ' ******************************** ' * circular nomogram formula * ' ******************************** ' assuming: tan(hla) = sin(lat) * tan(ha) then ' ' from xL the x value for the top HOUR ANGLE circle is:- ' ' x = S / ( 1 + tan**2(ha) ) ' ' from xL the x value for the lower LATITUDE circle is:- ' ' x = S / ( 1 + sin**2(lat) ) ' ' from xL the x value for the horizontal HOUR LINE ANGLE line is:- ' ' x = S / ( 1 + tan(hla) ) ' ' see pages 209 and 210 of THE NOMOGRAM by Allcock and Jones ' ****************************************** ' * making a usable X and Y for the circle * ' ****************************************** ' having an "x" value along the horizontal line is nice, but how do ' we get a Y value where a vertical line extended at "x" meets the circle ' ' by definition, the scale "S" is the semi-circle's diameter thus ' ' X = S/2 - x where X is the X from the semicircle center and ' where x is the value derived above ' ' ' + ' + + ' + S/2 + ' + Y + ' *..+....C........* length "*" to "*" is S ' S/2 is radius and hypotenuse ' < X > ' ' from the semi circle's center "C" we have the x value "X" ' and we have the radius which is "S/2" ' ' thus by Pythagorus Theorum ' ' (S/2)*(S/2) = X*X + Y*Y ' ' or ' ' Y*Y = (S/2)*(S/2) - X*X ' ' but X = S/2 - x ' ' Y = sqrt ( S*S/4 - X*X ) ' ' = sqrt ( S*S/4 - (S/2 - x)*(S/2 - x) ) now multiply the two parenthesis ' ' = sqrt ( S*S/4 - (S*S/4 - S*x/2 - x*S/2 + x*x) ) ' ' = sqrt ( S*S/4 - (S*S/4 - 2*S*x/2 + x*x) ) ' ' = sqrt ( S*S/4 - (S*S/4 - S*x + x*x) ) ' ' = sqrt ( S*S/4 - S*S/4 + S*x - x*x) ) ' ' = sqrt ( S*x - x*x) ) ' ' = sqrt ( S*x - x*x ) ' draw the two semi circles and the line dcCreateCircle xL+S/2 , y , S/2 dcCreateLine xL , 0 , xl+S, 0 ' set the text color, font, size, etc also dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 dcSetLineParms dcBLUE,dcSOLID,dcTHIN ' *** LATITUDE line is on the bottom ' ' x = S / ( 1 + sin**2(lat) ) ' ' and ' X*X means the square of the hypotenuse ' Y = sqrt ( S*x - x*x ) ' x here is S/2 - x ' dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 For lat = 0 To 90 Step 1 ' get x from xL distance x = S / ( 1 + (Sin(lat*2*3.1416/360)*Sin(lat*2*3.1416/360)) ) ' bigX is x from circle center and is used for Y calculation bigX = S/2 - Abs(x) ' x may have been L or R of center Y = Sqr ( s*x - x*x ) ' get x and y for screen location ~ i.e. adjust by yDisp and xL x = xL + x y = yDisp + y ' draw a marker line but only say number if 10 multiple If Abs(y) < S/4 Then If (lat/10 - Int(lat/10)) = 0 Then If lat < 80 Then dcSetTextParms dcBLACK,"Ariel","Bold",0,5, 20,0,0 dcCreateText x+0.15 , -y , 0, "H: "+Format(lat, "00") dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 dcCreateText x+0.30 , -y , 0, " (V: "+Format(90-lat, "00")+")" End If dcSetLineParms dcBLACK,dcSOLID,dcTHIN dcCreateLine x , -y, x+0.1 , -y Else dcCreateLine x , -y, x+0.05, -y End If End If If Abs(y) >= S/4 Then If (lat/10 - Int(lat/10)) = 0 Then If lat < 80 Then dcSetTextParms dcBLACK,"Ariel","Bold",0,5, 20,0,0 dcCreateText x , -y-0.15, 0, Format(lat, "00") dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 If lat>50 Then dcSetTextParms dcBLACK,"Ariel","Bold",0,3, 20,0,0 End If dcCreateText x , -y-0.25, 0, "(V: "+Format(90-lat, "00")+")" End If dcSetLineParms dcBLACK,dcSOLID,dcTHIN dcCreateLine x , -y, x , -y-0.1 Else dcCreateLine x , -y, x , -y-0.05 End If End If Next lat dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 dcCreateText xL + S/2 -1 , -S/2+0.6, 0, "Latitude: 1 degree increments" dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 dcCreateText xL + S/2 -1 , -y-0.15, 0, "H-dial inner larger numbers" dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 dcCreateText xL + S/2 -1 , -y-0.25, 0, "V-dial outer smaller numbers" ' *** HOUR ANGLE i.e. THE TIME i.e. the sun's hour angle is on the top ' ' x = S / ( 1 + tan**2(ha) ) ' ' and ' X*X means the square of the hypotenuse ' Y = sqrt ( S*x - x*x ) ' x here is S/2 - x ' dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 Dim ha As Single For ha = 0 To 24 Step 1 ' 24 quarter hours ' get x from xL distance (ha here is 4 times hour thus ha*0.25) ' (and of course 1 hour is 15 degrees) x = S / ( 1 + (Tan(ha*0.25*15*2*3.1416/360)*Tan(ha*0.25*15*2*3.1416/360)) ) ' bigX is x from circle center and is used for Y calculation bigX = S/2 - Abs(x) ' x may have been L or R of center Y = Sqr ( s*x - x*x ) ' get x and y for screen location ~ i.e. adjust by yDisp and xL x = xL + x y = yDisp + y ' draw a marker line but only say number if 10 multiple If Abs(y) < S/4 Then If (ha/4 - Int(ha/4)) = 0 Then If (ha>0 And ha<24) Then dcSetTextParms dcBLACK,"Ariel","Bold",0,5, 20,0,0 dcCreateText x+0.15 , y , 0, Format(ha/4, "00") End If dcSetLineParms dcBLACK,dcSOLID,dcTHIN dcCreateLine x , y, x+0.1 , y Else dcCreateLine x , y, x+0.07, y End If End If If Abs(y) >= S/4 Then If (ha/4 - Int(ha/4)) = 0 Then If (ha>0 And ha<24) Then dcSetTextParms dcBLACK,"Ariel","Bold",0,5, 20,0,0 dcCreateText x , y-0.15, 0, Format(ha/4, "00") End If dcSetLineParms dcBLACK,dcSOLID,dcTHIN dcCreateLine x , y, x , y-0.1 Else dcCreateLine x , y, x , y-0.07 End If End If Next ha dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 If chc = 11 Then dcCreateText xL + S/2 -1 , S/2-0.6, 0, "Hour from noon: 15 minute increments" End If If chc = 111 Then dcCreateText xL + S/2 -1 , S/2-0.6, 0, "Hour from noon: 5 minute increments" End If ' mark the minutes If chc = 111 Then For ha = 0 To 360 Step 5 x = S / ( 1 + (Tan(ha*0.25*2*3.1416/360)*Tan(ha*0.25*2*3.1416/360)) ) bigX = S/2 - Abs(x) Y = Sqr ( s*x - x*x ) x = xL + x y = yDisp + y If Abs(y) < S/4 Then If ha/60<3 Then dcCreateLine x , y, x+0.04, y End If If ha/60>3 Then dcCreateLine x , y, x-0.04, y End If End If If Abs(y) >= S/4 Then dcCreateLine x , y, x , y-0.04 End If Next ha End If ' *** HOUR LINE ANGLE of the dial plate's hour lines, in the center line ' ' x = S / ( 1 + tan(hla) ) ' ' not tan*tan for the horizontal line ' dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 For hla = 0 To 90 Step 1 ' get x from xL distance x = S / ( 1 + Tan(hla * 2*3.1416/360) ) Y = 0 ' get x and y for screen location ~ i.e. adjust by yDisp and xL x = xL + x y = yDisp + y ' draw a marker line ' but only say number if 10 multiple If (hla/10 - Int(hla/10)) = 0 Then If (hla>5 And hla<90) Then dcSetTextParms dcBLACK,"Ariel","Bold",0,5, 20,0,0 dcCreateText x-0.09, y-0.1, 0, Format(hla, "00.0") End If dcSetLineParms dcBLACK,dcSOLID,dcTHIN dcCreateLine x , y , x , -y-0.1 Else dcCreateLine x , y , x , -y-0.03 End If Next hla dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 dcCreateText xL + S/2 , 0+0.1, 0, "Hour line angle: 1 degree increments" dcCreateText xL + S/2 , 0+0.4, 0, "HORIZONTAL DIAL [H:lat]" dcCreateText xL + S/2 , 0+0.3, 0, "and VERTICAL,being 90-latitude [V:lat]" dcCreateText xL + S/2 , 0-0.2, 0, "www.illustratingshadows.com" dcCreateText xL + S/2 , 0-0.3, 0, "Simon Wheaton-Smith ~ open source" End Function ' ************************************************************************** ' *** *** ' *** 44 is choice 4 as a circvular nomogram being a Q-DIAL quadrant *** ' *** *** ' ************************************************************************** Function choice44 ' select all objects that may exist on the screen - p223 of Manual ' then erase them all - page 189 of Manual If (dcSelectAll) Then dcEraseSelObjs End If ' ******************************************************************** ' Now define the initial general working variables ' ******************************************************************** ' ' define a lat and a long, reference longitude, hour divisions Dim lat As Single Dim lng, ref, dvh, glh, r As Single ' ******************************************************************** ' Now get the lat, long, and reference longitude ' ******************************************************************** ' first set the defaults - here bbbbb.mylat uses the structure ' from aaaaa lat = 20 lng = 0 ref = 0 dvh = 4 glh = 0.25 ' ***************************************************************************** ' *** ok, what was returned? if ok then do the program itself *** ' ***************************************************************************** ' ************************************************************************** ' *** this is the main program to draw the horizontal dial itself *** ' ************************************************************************** ' calculate hour line angles next, but first define them Dim h, hx, hy As Single ' DeltaCAD is fussy about data attributes ' the formula is... hourlineangle = atan ( sin(lat) * tan (lha) ) ' almost all systems us radians ' the formula also needs adjustment for longitude displacement ' line color is 0 is black ' line type is dcsolid ' line weight is dcnormal ' establish the border boxes dimensions smallbox = 1.4 ' top=bot=left=right=1.7 largebox = 1.8 ' and 0.0 is center ' proper coding would use these values in the text stuff just below ' or added more parameters to control text locations ' set the text color, font, size, etc also dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 dcCreateText 0, -1.6, 0, "NOMOGRAM FOR SUNRISE/SET BASED ON Q-DIAL" dcCreateText 0, -1.7, 0, "HOURS FOM 0600 or 1800 for sunrise/set" dcSetLineParms dcBLACK,dcSOLID,dcTHICK ' NOW DRAW ALL HOUR LINES 'For hr = 0 To 23.9 Step (1/dvh) ' 1/dvh allows hour divisions For hr = 6 To 12 Step (1/dvh) ' 1/dvh allows hour divisions ' ================================================================= ' for the hour (hr) calculate the hour line angle (h) ' we default to the north face h = 0 + (15*hr) + (lng-ref) ' south face ' establish solid black for hours, blue dashed otherwise dcSetLineParms dcBLACK,dcSOLID,dcTHIN ' set black as default line color If ( hr - Int(hr) ) <> 0 Then dcSetLineParms dcBLUE,dcSTITCH,dcTHIN ' but if not full hour change End If ' ------------------------------------------------------------ ' NOTE code for keeping lines in a boxed area ' ------------------------------------------------------------ ' h can be 0 through 360 ' top of box would be +315 to 045 ' rt of box would be 045 to 135 ' bot of box would be 135 to 235 ' lft of box would be 235 to 315 If h > 315 Or h <= 045 Then ' lines touch top of box dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 21,0,0 hx = smallbox * Tan(rad((h))) dcCreateLine 0,0,hx, smallbox ' dont say hour if not integer hour If ( hr - Int(hr) ) = 0 Then dcCreateText (hx), smallbox+0.1, 0, Abs(hr-6) End If ElseIf h > 45 And h <= 135 Then ' lines touch right side of box dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 hy = smallbox * Tan(rad((90-h))) dcCreateLine 0,0, smallbox, hy ' dont say hour if not integer hour If ( hr - Int(hr) ) = 0 Then dcCreateText smallbox+0.1, hy, 0, Abs(hr-6) End If ElseIf h > 135 And h <= 225 Then ' lines touch bottom of box dcSetTextParms dcRED,"Ariel","Bold",0,6, 20,0,0 ' the y value of the line end is ---> smallbox ' the x value of the end of the line is ' th = 180 = h th = h - 180 ' so we have -45 to +45 hx = smallbox * Tan(rad((th))) dcCreateLine 0,0, -hx , -smallbox ' dont say hour if not integer hour If ( hr - Int(hr) ) = 0 Then dcCreateText -hx, -(smallbox+0.1), 0, Abs(hr-6) End If ElseIf h > 225 And h <= 315 Then ' lines touch left side of box dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 hy = smallbox * Tan(rad((90-h))) dcCreateLine 0,0,-smallbox,-hy ' dont say hour if not integer hour If ( hr - Int(hr) ) = 0 Then dcCreateText -(smallbox+0.1), -hy, 0, Abs(hr-6) End If End If ' ======================================================================= Next hr ' NOW DRAW SOME DECLINATION CIRCLES dcSetCircleParms dcBLACK, dcSOLID, dcTHIN dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 For lat = 10 to 24 step 2 ' less than decl 8 is excessive r = glh / Tan(rad(lat)) ' dcCreateCircle 0,0,r ' 2 month from solstice dcCreateCircleEx 0,0, 0,-r, r,0, r,r,0,0 dcCreateText 0, -(r-0.05), 0, "DECL: "+Format(lat,"00") Next lat ' NOW DRAW SUNRISE SET LINE ' y = tan(latitude) * gnomon linear height dcSetLineParms dcBLACK,dcSOLID,dcTHIN dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 For lat = 20 to 60 step 5 r = glh * Tan(rad(lat)) r = -1 * r dcCreateLine 0 , r, smallbox, r dcCreateText 0.5+((lat-20)/40), (r+0.02), 0, "LAT "+Format(lat,"00") Next lat dcSetTextParms dcRED,"Ariel","Bold",0,6, 20,0,0 ' NOW PUT FINAL BOXES IN PLACE ' draw a box around everything ~ p184 Manual left, bottom, right, top dcCreateBox 0,0, smallbox, -smallbox ' dcCreateBox -0.3, 0.2, largebox-0.1, -largebox dcViewBox -(largebox+0.2), -(largebox+0.2), (largebox+0.2), (largebox+0.2) ' page 225 Manual left, bot, top, rt 'eotdecl End Function ' ************************************************************************** ' *** *** ' *** 55 is choice 5 but as a N or Z nomogram *** ' *** *** ' ************************************************************************** Function choice55 ' distance up an hour line to calendar pt = tan (declination) / cos (time ) ' *** Set X coordinates ' xL left ' xC center - answer ' xR right xl = 0.0 xc = 0.5 xr = 1.0 ' *** set size multiplier ~ and this is used in the center scale answer Dim s1, s2 As Single s1 = 4.0 ' left <<<<< s2 = 2.0 ' right <<<<< ' *** set scale range for user 'Dim m1, m2 As Single m1 = 24 ' left m2 = 6 ' right ' *** set modulus Dim Md1, Md2 As Single Md1 = Tan(24*2*3.14159/360) Md2 = Cos(0*2*3.14159/360) ' set the text color, font, size, etc also dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 dcSetLineParms dcBLACK,dcSOLID,dcTHIN ' **************** ' *** L E F T *** ' **************** ' *** SOLAR DECLINATION of the dial plate's hour lines on the left For decl = 0 To m1 Step 1 ' save y low and high values y = - s1 * Tan(decl*2*3.1416/360) ' minus ~ so scale goes down If decl = 0 Then yhi = y Else ylo = y End If ' draw a marker line but only say number if 10 multiple If (decl/10 - Int(decl/10)) = 0 Then dcCreateText xl-0.15 , y, 0, Format( decl, "#0") dcCreateLine xl, y, xl-0.1, y Else dcCreateText xl-0.15 , y, 0, Format( decl, "#0") dcCreateLine xl, y, xl-0.02, y End If Next hr ' *** SOLAR DECLINATION of the dial plate's hour lines on the right - continued dcCreateText xl-0.3 , ylo-0.22 , 0, "SOLAR DECLINATION" dcCreateText xl-0.3 , ylo-0.14 , 0, "SOLSTICE" dcCreateText xl-0.3 , ylo-0.06 , 0, "JUNE & DECEMBER" dcCreateText xl-0.3 , yhi+0.1 , 0, "EQUINOX" dcCreateText xl-0.3 , yhi+0.18 , 0, "MARCH & SEPTEMBER" dcCreateLine xl, ylo, xl, yhi ' save the line bottom for the N or Z line 'Dim xxxx,yyyy As Single Dim yyyyy As Single xxxx = xl yyyy = yhi yyyyy= ylo ' ****************** ' *** R I G H T *** ' ****************** ' *** 1/cos(lat) line is on the right ' but cos(lat) used because the N or Z nomogram implies the 1/value For hr = 0 To m2 Step 0.25 ' save y low and high values ' 1.5+ moves the bottom line up ' s2 sets the size of the line y = 0.0+yyyyy + s2 * Cos(15*(hr)*2*3.1416/360) If hr = 0 Then ylo = y Else yhi = y End If ' draw a marker line but only say number if 10 multiple If (hr - Int(hr)) = 0 Then dcCreateText xr+0.08, y, 0, Format(hr, "#0") dcSetTextParms dcBLUE,"Ariel","Bold",0,2, 20,0,0 dcCreateText xr-0.10, y, 0, Format(Cos(15*(hr)*2*3.1416/360), "#0.000") dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 ' NOTE: This is the 1/cos line but we show tan(hr) as it is a SOLUTION If (Abs(Tan(15*(hr)*2*3.1416/360))<100) Then dcCreateText xr+0.17, y, 0, Format(Tan(15*(hr)*2*3.1416/360), "#0.000") End If dcCreateLine xr, y, xr+0.05, y Else dcCreateLine xr, y, xr+0.02, y End If Next hr dcCreateLine xr, ylo, xr, yhi dcCreateText xr+0.08 , ylo+0.1, 0, "HOURS FROM TRANSIT" dcCreateText xr , yhi-0.1, 0, "DIST TO HR.LN" dcCreateText xr , yhi-0.2, 0, "ANSWER 1" dcSetTextParms dcBLUE ,"Ariel","Bold",0,2, 20,0,0 dcCreateText xr-0.10 , ylo+0.05, 0, "cos" dcSetTextParms dcBLACK ,"Ariel","Bold",0,4, 20,0,0 dcCreateText xr+0.08 , ylo+0.05, 0, "Hr" dcCreateText xr+0.17 , ylo+0.05, 0, "tan" ' save the line bottom for the N or Z line 'Dim xxx,yyy As Single xxx = xr ' yyy = yhi yyy = yhi ' ****************** ' *** N O T E S *** ' ****************** dcSetTextParms dcBLACK,"Ariel","Bold",0,3, 20,0,0 dcCreateText xl-0.3, ylo+0.40, 0, "POLAR (and meridian E/W) DIAL www.illustratingshadows.com" dcCreateText xl-0.3, ylo+0.35, 0, "1. The EOT must be added to correct the times" dcCreateText xl-0.3, ylo+0.30, 0, "2. If west of meridian, add 4*long diff" dcCreateText xl-0.3, ylo+0.25, 0, " If east of meridian, subtract 4*long diff" dcCreateText xl-0.3, ylo+0.20, 0, "Assumes a style linear height of 1.0" dcCreateText xl-0.3, ylo+0.15, 0, "Draw line from hour to declination, read (1) HR LINE DIST" dcCreateText xl-0.3, ylo+0.10, 0, "as well as (2) distance on hour line to calendar point" dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 ' ******************** ' *** C E N T E R *** ' ******************** ' *** DISTANCE ON HOUR LINE FOR THIS DECL's CALENDAR POINT ' ' decpt = tan(decl) * 1/cos(time) ' ' hour scale m1 = ' decl scale m2 = ' decpt scale m3 = pq [along the diagonal] = ( pr * v ) / ( (m2/m1) + v ) ' where "v" is the value of the data point ' 'Dim pr As Single 'Dim pq As Single ' pr is the length of the diagonal pr = Sqr( (xxxx-xxx)*(xxxx-xxx) + (yyyy-yyy)*(yyyy-yyy) ) dcCreateLine xxx,yyy,xxxx,yyyy 'Dim decdist As Single For decpt = 0 To 3 Step 0.1 ' get point along the diaganol ~ Z = L f3(w) / [(m2/m1) + f3(w)] pq = ( pr * decpt ) / (( s2/s1 ) + decpt) ' need an x and a y for that distance x = xxxx + ((xxx-xxxx) * (pq/pr)) y = yyyy + ((yyy-yyyy) * (pq/pr)) ' draw a marker line but only say number if integer If decpt <1 Then dcCreateText x+0.1 , y, 0, Format(decpt , "#0.0") dcCreateLine x, y, x+0.04, y End If If decpt >=1 Then ' draw a marker line but only say number if integer If (decpt - Int(decpt) < 0.001 ) Then dcCreateText x+0.1 , y, 0, Format(decpt , "#0.0") dcCreateLine x, y, x+0.08, y Else dcCreateLine x, y, x+0.02, y End If End If Next decpt dcCreateText xc-0.4 , yhi+0.5, 0, "DIST ALONG HR.LN" dcCreateText xc-0.4 , yhi+0.4, 0, "ANSWER 2" ' *** show EOT and DECL for the dial plate eotDecl End Function Function choice6 ' ************************************************************************** ' *** *** ' *** SD style distance sd = atan( Sin(dec) / Tan(lat) ) *** ' *** *** ' ************************************************************************** ' sd = atan( Sin(dec) / Tan(lat) ) thus ' ' tan(sd) = Sin(dec) / Tan(lat) thus ' ' log tan(sd) = log Sin(dec) + log ( 1 / Tan(lat) ) ' *** Set X coordinates ' X = -1 latitude ' X = 0 resulting hour line angle ' X = +1 hour angle of the sun xl = -1 xc = 0 xr = 1 ' set the text color, font, size, etc also dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 dcSetLineParms dcBLACK,dcSOLID,dcTHIN ' *** 1/tan(lat) LATITUDE line is on the left dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 For lat = 20 To 60 Step 1 ' save y low and high values y = Log(1/Tan(lat*2*3.1416/360)) If lat = 20 Then ylo = y Else yhi = y End If ' draw a marker line ' but only say number if 10 multiple If (lat/10 - Int(lat/10)) = 0 Then dcCreateText xl+0.1 , y, 0, Format(lat, "#0") dcSetLineParms dcBLACK,dcSOLID,dcTHIN dcCreateLine xl, y, xl-0.3, y Else dcCreateLine xl, y, xl-0.1, y End If Next hr dcCreateLine xl, ylo, xl, yhi dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 dcCreateText xl-0.5 , ylo+0.1, 0, "LATITUDE" dcCreateText xl-0.5 , yhi-0.1, 0, "LATITUDE" dcSetTextParms dcBLACK,"Ariel","Bold",0,10, 20,0,0 ' *** SD Style Distance ' ' decpt = tan(decl) * 1/cos(time) ' ' log tan(sd) = log Sin(dec) + log ( 1 / Tan(lat) ) ' dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 For decpt = 1 To 60 Step 1 ' save y low and high values y = 0.5 * Log(Tan(2*3.1416*decpt/360)) If decpt = 1 Then ylo = y Else yhi = y End If ' draw a marker line but only say number if integer If (decpt/10 - Int(decpt/10)) = 0 Then dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 dcCreateText xc-0.1 , y, 0, Format(decpt , "#0") dcSetLineParms dcBLACK,dcSOLID,dcTHIN dcCreateLine xc, y, xc+0.3, y ElseIf decpt <10 Then dcCreateLine xc, y, xc+0.1, y dcCreateText xc-0.1 , y, 0, Format(decpt , "0.0") Else dcCreateLine xc, y, xc+0.1, y End If Next decpt dcCreateLine xc, ylo, xc, yhi dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 dcCreateText xc-0.3 , ylo-0.1, 0, "SD angle" dcSetTextParms dcBLACK,"Ariel","Bold",0,10, 20,0,0 dcCreateText xc-0.3 , ylo-0.35, 0, "ANSWER" dcCreateText xc-0.3 , yhi+0.50, 0, "VERTICAL DECLINER DIAL" dcCreateText xc-0.3 , yhi+0.35, 0, "SD STYLE DISTANCE NOMOGRAM" dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 ' *** WALL DECLINATION of the dial plate line on the right dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 ' log tan(sd) = log Sin(dec) + log ( 1 / Tan(lat) ) For decl = 3 To 70 Step 1 ' save y low and high values ' but mid scale is 0.5 of actual y = Log(Sin(decl*2*3.1416/360)) If decl = 3 Then ylo = y Else yhi = y End If ' draw a marker line ' but only say number if 10 multiple If (decl/10 - Int(decl/10)) = 0 Then dcCreateText xr-0.15 , y, 0, Format( decl, "#0") dcSetLineParms dcBLACK,dcSOLID,dcTHIN dcCreateLine xr, y, xr+0.3, y Else dcCreateLine xr, y, xr+0.1, y If decl < 20 Then dcCreateText xr-0.15 , y, 0, Format( decl, "#0") End If End If Next hr ' *** WALL DECLINATION of the dial plate's hour lines on the right - continued dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 dcCreateText xr-0.5 , yhi+0.1 , 0, "WALL DECLINATION" dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 dcCreateLine xr, ylo, xr, yhi dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 End Function ' ************************************************************************** ' *** *** ' *** SH style height sh = asin( Cos(lat) * Cos(dec) ) *** ' *** *** ' ************************************************************************** Function choice7 ' *** Set X coordinates ' X = -1 latitude ' X = 0 resulting hour line angle ' X = +1 hour angle of the sun xl = -0.5 xc = 0 xr = 0.5 ' set the text color, font, size, etc also dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 dcSetLineParms dcBLACK,dcSOLID,dcTHIN ' *** cos(lat) LATITUDE line is on the left dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 For lat = 20 To 60 Step 1 ' save y low and high values y = 6* Log(Cos(lat*2*3.1416/360)) If lat = 20 Then ylo = y Else yhi = y End If ' draw a marker line ' but only say number if 10 multiple If (lat/10 - Int(lat/10)) = 0 Then dcCreateText xl+0.1 , y, 0, Format(lat, "#0") dcSetLineParms dcBLACK,dcSOLID,dcTHIN dcCreateLine xl, y, xl-0.3, y Else dcCreateLine xl, y, xl-0.1, y End If Next hr dcCreateLine xl, ylo, xl, yhi dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 dcCreateText xl-0.5 , ylo+0.1, 0, "LATITUDE" dcCreateText xl-0.5 , yhi-0.1, 0, "LATITUDE" dcSetTextParms dcBLACK,"Ariel","Bold",0,10, 20,0,0 ' *** SH Style Distance ' dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 For decpt = 15 To 60 Step 1 ' save y low and high values y = 3 * Log(Sin(2*3.1416*decpt/360)) If decpt = 15 Then ylo = y Else yhi = y End If ' draw a marker line but only say number if integer If (decpt/10 - Int(decpt/10)) = 0 Then dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 dcCreateText xc-0.1 , y, 0, Format(decpt , "#0") dcSetLineParms dcBLACK,dcSOLID,dcTHIN dcCreateLine xc, y, xc+0.3, y ElseIf decpt <20 Then dcCreateLine xc, y, xc+0.1, y dcCreateText xc-0.1 , y, 0, Format(decpt , "0") Else dcCreateLine xc, y, xc+0.1, y End If Next decpt dcCreateLine xc, ylo, xc, yhi dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 dcCreateText xc-0.3 , ylo-0.1, 0, "SH angle" dcSetTextParms dcBLACK,"Ariel","Bold",0,10, 20,0,0 dcCreateText xc-0.3 , ylo-0.35, 0, "ANSWER" dcCreateText xl-0.5 , yhi+0.65, 0, "VERTICAL DECLINER DIAL" dcCreateText xl-0.5 , yhi+0.5, 0, "SH STYLE HEIGHT NOMOGRAM" dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 ' *** WALL DECLINATION of the dial plate line on the right dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 For decl = 10 To 60 Step 1 ' save y low and high values ' but mid scale is 0.5 of actual y = 6* Log(Cos(decl*2*3.1416/360)) If decl = 10 Then ylo = y Else yhi = y End If ' draw a marker line ' but only say number if 10 multiple If (decl/10 - Int(decl/10)) = 0 Then dcCreateText xr-0.15 , y, 0, Format( decl, "#0") dcSetLineParms dcBLACK,dcSOLID,dcTHIN dcCreateLine xr, y, xr+0.3, y Else dcCreateLine xr, y, xr+0.1, y If decl < 10 Then dcCreateText xr-0.15 , y, 0, Format( decl, "#0") End If End If Next hr ' *** WALL DECLINATION of the dial plate's hour lines on the right - continued dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 dcCreateText xr , yhi-0.1 , 0, "WALL DECLINATION" ' *** WALL DECLINATION of the dial plate's hour lines on the right - continued dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 dcCreateLine xr, ylo, xr, yhi dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 End Function ' ************************************************************************** ' *** *** ' *** DL difference in longitude = -(Atn(Tan(dec)/Sin(lat)))-(lng-ref) *** ' *** *** ' ************************************************************************** Function choice8 ' *** Set X coordinates ' X = -1 latitude ' X = 0 resulting hour line angle ' X = +1 hour angle of the sun xl = -1 xc = 0 xr = 1 ' set line parameters dcSetLineParms dcBLACK,dcSOLID,dcTHIN ' *** 1/sin(lat) LATITUDE line is on the left dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 For lat = 30 To 80 Step 1 ' save y low and high values y = Log(1/Sin(lat*2*3.1416/360)) If lat = 30 Then ylo = y Else yhi = y End If ' draw a marker line ' but only say number if 10 multiple If (lat/10 - Int(lat/10)) = 0 Then dcCreateText xl+0.1 , y, 0, Format(lat, "#0") dcSetLineParms dcBLACK,dcSOLID,dcTHIN dcCreateLine xl, y, xl-0.3, y Else dcCreateLine xl, y, xl-0.1, y End If Next hr dcCreateLine xl, ylo, xl, yhi dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 dcCreateText xl-0.5 , ylo+0.1, 0, "LATITUDE" dcCreateText xl-0.5 , yhi-0.1, 0, "LATITUDE" dcSetTextParms dcBLACK,"Ariel","Bold",0,10, 20,0,0 ' *** DL difference in longitude For decpt = 1 To 60 Step 1 ' save y low and high values y = 0.5 * Log(Tan(2*3.1416*decpt/360)) If decpt = 1 Then ylo = y Else yhi = y End If ' draw a marker line but only say number if integer If (decpt/10 - Int(decpt/10)) = 0 Then dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 dcCreateText xc-0.1 , y, 0, Format(decpt , "#0") dcSetLineParms dcBLACK,dcSOLID,dcTHIN dcCreateLine xc, y, xc+0.3, y ElseIf decpt <10 Then dcCreateLine xc, y, xc+0.1, y dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 dcCreateText xc-0.1 , y, 0, Format(decpt , "0") Else dcCreateLine xc, y, xc+0.1, y End If Next decpt dcCreateLine xc, ylo, xc, yhi dcSetTextParms dcBLACK,"Ariel","Bold",0,9, 20,0,0 dcCreateText xc-0.8 , ylo , 0, "DL angle" dcSetTextParms dcBLACK,"Ariel","Bold",0,10, 20,0,0 dcCreateText xc-0.3 , ylo-0.35, 0, "ANSWER" dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 dcSetTextParms dcBLACK,"Ariel","Bold",0,9, 20,0,0 dcCreateText xc-0.6 , yhi+0.65, 0, "VERTICAL DECLINER DIAL" dcCreateText xc-0.6 , yhi+0.5, 0, "DL difference in longitude" ' *** WALL DECLINATION of the dial plate line on the right dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 For decl = 3 To 60 Step 1 ' save y low and high values ' but mid scale is 0.5 of actual y = Log(Tan(decl*2*3.1416/360)) If decl = 3 Then ylo = y Else yhi = y End If ' draw a marker line ' but only say number if 10 multiple If (decl/10 - Int(decl/10)) = 0 Then dcCreateText xr-0.15 , y, 0, Format( decl, "#0") dcSetLineParms dcBLACK,dcSOLID,dcTHIN dcCreateLine xr, y, xr+0.3, y Else dcCreateLine xr, y, xr+0.1, y If decl < 10 Then dcCreateText xr-0.15 , y, 0, Format( decl, "#0") End If End If Next hr ' *** WALL DECLINATION of the dial plate's hour lines on the right - continued dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 dcCreateText xr , yhi+0.1 , 0, "WALL DECLINATION" ' *** WALL DECLINATION of the dial plate's hour lines on the right - continued dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 dcCreateLine xr, ylo, xr, yhi End Function ' ************************************************************************** ' *** analemmatic dial nomogram itself *** ' ************************************************************************** Function choice9 ' *** Set X coordinates ' X = -1 latitude ' X = 0 resulting hour line angle ' X = +1 hour angle of the sun Dim xl, xr, xc As Single Dim x As Single xl = -1.5 xc = -0.5 xr = +0.5 ' set the text color, font, size, etc also dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 dcSetLineParms dcBLUE,dcSOLID,dcTHIN ' *** LATITUDE line is on the left *** and has minor N|S radius also *** dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 Dim lat As Single For lat = 10 To 80 Step 2 ' save y low and high values y = Log(Sin(lat*2*3.1416/360)) If lat = 10 Then ylo = y Else yhi = y End If ' draw a marker line ' but only say number if 10 multiple If (lat/10 - Int(lat/10)) = 0 Then dcCreateText xl+0.03 , y, 0, Format(lat, "00") dcCreateText xl-0.5 , y, 0, Format(Sin(2*3.1416*lat/360), "0.000") dcSetLineParms dcBLACK,dcSOLID,dcTHIN dcCreateLine xl, y, xl-0.3, y Else dcCreateLine xl, y, xl-0.1, y End If Next lat dcCreateLine xl, ylo, xl, yhi dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 dcCreateText xl+0.03 , yhi+0.2, 0, "Latitude" dcCreateText xl+0.03, yhi+0.1, 0, "by 2 degrees" dcCreateText xl-0.5 , yhi+0.2, 0, "m (minor" dcCreateText xl-0.5 , yhi+0.1, 0, " radius)" dcCreateText xl-0.5 , ylo-0.1, 0, "m = N or S to equinox radius " dcCreateText xl-0.5 , ylo-0.2, 0, "assumes M = E or W to N|S" dcCreateText xl-0.5 , ylo-0.3, 0, "assumes M = radius of 1" dcSetTextParms dcBLACK,"Ariel","Bold",0,8, 20,0,0 dcCreateText xl-0.5 , ylo-0.4, 0, "ANSWER 1 (m.mmm) " dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 ' *** HOUR ANGLE i.e. TIME of the sun line is on the right dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 Dim hr As Single For hr = 0.25 To 5.75 Step 0.25 ' save y low and high values y = Log(Cos(15*hr*2*3.1416/360)) ' cos is for the hour marker If hr = 0.25 Then ylo = y Else yhi = y End If ' draw a marker line ' but only say number if 10 multiple If (hr - Int(hr)) = 0 Then dcCreateText xr-0.15 , y, 0, Format(hr, "00.00") ' sin for the "m" minor radius being north/south dcSetLineParms dcBLACK,dcSOLID,dcTHIN dcCreateLine xr, y, xr+0.3, y Else dcCreateLine xr, y, xr+0.1, y End If If ((hr >= 2) Or (hr = 1)) Then dcCreateText xr+0.30 , y, 0, Format(Sin(2*3.1416*15*hr/360), "0.000") End If Next hr dcCreateLine xr, ylo, xr, yhi dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 dcCreateText xr-0.15 , ylo+0.2, 0, "Hour from noon in" dcCreateText xr-0.15 , ylo+0.1, 0, "15 minute increments" dcCreateText xr-0.25 , yhi-0.1, 0, "X from n|s line (assumes" dcCreateText xr-0.25 , yhi-0.2, 0, "M = E or W radius is 1)" dcSetTextParms dcBLACK,"Ariel","Bold",0,8, 20,0,0 dcCreateText xr-0.25 , yhi-0.3, 0, "ANSWER 2 (X.XXX)" dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 ' *** main header for nomogram *** dcCreateText xl-0.5 , yhi+0.1, 0, "ANALEMMATIC DIAL www.illustratingshadows.com" dcCreateText xl-0.5 , yhi+0.0, 0, "M = west to center, or center to east radius = 1" dcCreateText xl-0.5 , yhi-0.1, 0, "m = equinox to north or to south radius, if M=1" dcCreateText xl-0.5 , yhi-0.2, 0, "Chapter 21 of Illustrating Times Shadow" dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 ' *** Y of the dial plate's hours, in the center dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 Dim hla As Single For hla = 1 To 50 Step 1 ' this trick allows INTEGER loop to achieve 1/10th etc as a step hr = hla / 50 ' save y low and high values ' but mid scale is 0.5 of actual y = 0.5 * Log(hr) If hla = 1 Then ylo = y Else yhi = y End If ' draw a marker line ' but only say number if 10 multiple If (10*hr-Int(10*hr)=0) Then ' If (hr/10 - Int(hr/10)) = 0 Then dcCreateText xc-0.15 , y, 0, Format(hr, "0.000") dcSetLineParms dcBLACK,dcSOLID,dcTHIN dcCreateLine xc, y, xc+0.1, y Else dcCreateLine xc, y, xc+0.05, y End If Next hla dcCreateLine xc, ylo, xc, yhi dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 dcCreateText xc-0.35 , yhi+0.3, 0, "Y from equinox line assumes" dcCreateText xc-0.35 , yhi+0.2, 0, "M = E or W radius is 1" dcSetTextParms dcBLACK,"Ariel","Bold",0,8, 20,0,0 dcCreateText xc-0.35 , yhi+0.1, 0, "ANSWER 3 (Y.YYY)" dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 ' eotdecl End Function ' *** PART 2 *** this does the calendar point based on the latitude and declination ' dist on N|S line is: M * cos(lat) * tan(dec) Function choice99 ' *** Set X coordinates ' X = -1 latitude ' X = 0 resulting hour line angle ' X = +1 hour angle of the sun Dim xl, xr, xc As Single Dim x As Single xl = -1.2 xc = -0.2 xr = +0.8 ' set the text color, font, size, etc also dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 dcSetLineParms dcBLUE,dcSOLID,dcTHIN ' *** LATITUDE line is on the left *** and has minor N|S radius also *** dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 Dim lat As Single For lat = 10 To 80 Step 2 ' save y low and high values y = Log(Cos(lat*2*3.1416/360)) If lat = 10 Then ylo = y Else yhi = y End If ' draw a marker line ' but only say number if 10 multiple If (lat/10 - Int(lat/10)) = 0 Then dcCreateText xl+0.02, y, 0, Format(lat, "00") dcCreateText xl-0.5 , y, 0, Format(Sin(2*3.1416*lat/360), "0.000") dcSetLineParms dcBLACK,dcSOLID,dcTHIN dcCreateLine xl, y, xl-0.3, y Else dcCreateLine xl, y, xl-0.1, y End If Next lat dcCreateLine xl, ylo, xl, yhi dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 dcCreateText xl , ylo+0.2, 0, "Latitude" dcCreateText xl , ylo+0.1, 0, "by 2 degrees" dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 dcCreateText xl-0.5 , ylo+0.2, 0, "m (minor" dcCreateText xl-0.5 , ylo+0.1, 0, " radius)" dcCreateText xl-0.5 , yhi-0.1, 0, "m = N or S to equinox radius " dcCreateText xl-0.5 , yhi-0.2, 0, "assumes M = E or W to N|S" dcCreateText xl-0.5 , yhi-0.3, 0, "assumes M = radius of 1" dcSetTextParms dcBLACK,"Ariel","Bold",0,8, 20,0,0 dcCreateText xl-0.5 , yhi-0.4, 0, "ANSWER 1 (m.mmm) " dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 ' *** main header for nomogram *** dcCreateText xl-0.5 , yhi-0.7, 0, "ANALEMMATIC DIAL www.illustratingshadows.com" dcCreateText xl-0.5 , yhi-0.8, 0, "Relative distance on N:S line for gnomon base" dcCreateText xl-0.5 , yhi-0.9, 0, "M = west to center, or center to east radius = 1" dcCreateText xl-0.5 , yhi-1.0, 0, "Chapter 21 of Illustrating Times Shadow" dcSetTextParms dcRED ,"Ariel","Bold",0,6, 20,0,0 ' *** DECLINATION dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 Dim hr As Single For hr = 1 To 24 Step 1 ' save y low and high values y = Log(Tan(hr*2*3.1416/360)) ' cos is for the hour marker If hr = 1 Then ylo = y Else yhi = y End If ' draw a marker line dcCreateText xr-0.15 , y, 0, Format(hr, "00.00") ' sin for the "m" minor radius being north/south dcSetLineParms dcBLACK,dcSOLID,dcTHIN dcCreateLine xr, y, xr+0.1, y Next hr dcCreateLine xr, ylo, xr, yhi dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 dcCreateText xr-0.15 , yhi+0.2, 0, "Declination in 1" dcCreateText xr-0.15 , yhi+0.1, 0, "degree increments" ' *** Y of the gnomon base on the N:S line dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 Dim hla As Single For hla = 1 To 50 Step 1 ' this trick allows INTEGER loop to achieve 1/10th etc as a step hr = hla / 50 ' save y low and high values ' but mid scale is 0.5 of actual y = 0.5 * Log(hr) If hla = 1 Then ylo = y Else yhi = y End If ' draw a marker line ' but only say number if 10 multiple If (10*hr-Int(10*hr)=0) Then ' If (hr/10 - Int(hr/10)) = 0 Then dcCreateText xc-0.15 , y, 0, Format(hr, "0.000") dcSetLineParms dcBLACK,dcSOLID,dcTHIN dcCreateLine xc, y, xc+0.1, y Else dcCreateLine xc, y, xc+0.05, y End If Next hla dcCreateLine xc, ylo, xc, yhi dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 dcCreateText xc-0.35 , yhi+0.3, 0, "Y from equinox line assumes" dcCreateText xc-0.35 , yhi+0.2, 0, "M = E or W radius is 1" dcSetTextParms dcBLACK,"Ariel","Bold",0,8, 20,0,0 dcCreateText xc-0.35 , yhi+0.1, 0, "ANSWER 4 (Y.YYY)" dcSetTextParms dcBLACK,"Ariel","Bold",0,6, 20,0,0 eotdecl End Function ' ***************************************************************************** ' *** FUNCTIONS SUBSERVIANT TO THE ENTIRE PROGRAM ITSELF *** ' ***************************************************************************** ' ***************************************************************************** ' *** Subroutine to show EOT and DECL *** ' ***************************************************************************** Function eotDecl ' *** character strings for the month Dim MoList(13) As String ' show date as Jan ... Dec Molist(1) = "Jan" ' there are other ways of doing this Molist(2) = "Feb" Molist(3) = "Mar" Molist(4) = "Apr" Molist(5) = "May" Molist(6) = "Jun" Molist(7) = "Jly" Molist(8) = "Aug" Molist(9) = "Sep" Molist(10) = "Oct" Molist(11) = "Nov" Molist(12) = "Dec" Molist(13) = "~~~" ' *** number of days in the month Dim Dom(12) As Integer ' days in the month Dom(1) = 31 Dom(2) = 28 Dom(3) = 31 Dom(4) = 30 Dom(5) = 31 Dom(6) = 30 Dom(7) = 31 Dom(8) = 31 Dom(9) = 30 Dom(10) = 31 Dom(11) = 30 Dom(12) = 31 ' *** coordinates for print layout Dim xl,yl As Single Dim nn As Integer ' *** working variables - day of year Dim jd As Integer Dim M,d As Single ' location on screen for final list yl = 0 xl = 1.5 ' *** display data ' color font style a pt flags (0=left, top, left justify) dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 dcCreateText xl+0.2, yl+0.06, 0, "EOT mm.m" dcCreateText xl+0.6, yl+0.06, 0, "DEC dd.d" jd = 1 For M = 1 To 12 Step 1 dcCreateText xl, yl, 0, molist(M) For d = 1 To 25 Step 10 ' set the text color, font, size, etc also dcCreateText xl+0.2 , yl, 0, Format(d ,"#0") ' *** calculate the EOT eot = 7.36*Sin(2*3.1416*(jd-4.21)/365) + 9.92*Sin(4*3.1416*(jd+9.9)/365) ' *** calculate the decl dec = 23.45 * Sin((2*3.1416/360)*(0.9678*(jd-80))) ' simple formula ' *** display results If eot > 0 Then dcCreateText xl+0.4, yl, 0, "+"+Format(eot,"###0.0") Else dcCreateText xl+0.4, yl, 0, " "+Format(eot,"###0.0") End If dcCreateText xl+0.6, yl, 0, " "+Format(dec,"###0.0") yl = yl - 0.06 jd = jd + 10 Next d Next M dcCreateBox xl-0.1, 0.1, xl+0.9, yl End Function ' ***************************************************************************** ' *** Subroutine to show EOT and DECL *** ' ***************************************************************************** Function eotDecl2 ' *** character strings for the month Dim MoList(13) As String ' show date as Jan ... Dec Molist(1) = "Jan" ' there are other ways of doing this Molist(2) = "Feb" Molist(3) = "Mar" Molist(4) = "Apr" Molist(5) = "May" Molist(6) = "Jun" Molist(7) = "Jly" Molist(8) = "Aug" Molist(9) = "Sep" Molist(10) = "Oct" Molist(11) = "Nov" Molist(12) = "Dec" Molist(13) = "~~~" ' *** number of days in the month Dim Dom(12) As Integer ' days in the month Dom(1) = 31 Dom(2) = 28 Dom(3) = 31 Dom(4) = 30 Dom(5) = 31 Dom(6) = 30 Dom(7) = 31 Dom(8) = 31 Dom(9) = 30 Dom(10) = 31 Dom(11) = 30 Dom(12) = 31 ' *** coordinates for print layout Dim xl,yl As Single Dim nn As Integer ' *** working variables - day of year Dim jd As Integer Dim M,d As Single ' location on screen for final list yl = 2 xl = 1.5 ' *** display data ' color font style a pt flags (0=left, top, left justify) dcSetTextParms dcBLACK,"Ariel","Bold",0,4, 20,0,0 dcCreateText xl+0.2, yl+0.06, 0, "EOT mm.m" dcCreateText xl+0.6, yl+0.06, 0, "DEC dd.d" jd = 1 For M = 1 To 12 Step 1 dcCreateText xl, yl, 0, molist(M) For d = 1 To 25 Step 10 ' set the text color, font, size, etc also dcCreateText xl+0.2 , yl, 0, Format(d ,"#0") ' *** calculate the EOT eot = 7.36*Sin(2*3.1416*(jd-4.21)/365) + 9.92*Sin(4*3.1416*(jd+9.9)/365) ' *** calculate the decl dec = 23.45 * Sin((2*3.1416/360)*(0.9678*(jd-80))) ' simple formula ' *** display results If eot > 0 Then dcCreateText xl+0.4, yl, 0, "+"+Format(eot,"###0.0") Else dcCreateText xl+0.4, yl, 0, " "+Format(eot,"###0.0") End If dcCreateText xl+0.6, yl, 0, " "+Format(dec,"###0.0") yl = yl - 0.06 jd = jd + 10 Next d Next M dcCreateBox xl-0.1, yl-0.1, xl+0.9, yl+2.5 End Function ' ***************************************************************************** ' *** Useful routines or functions - Functions must be defined at the end *** ' *** after the main profram which is sub(xx) ... end sub *** ' ***************************************************************************** ' Convert degrees to radians Function Rad ( n As Single ) As Single ' page 83 basic.pdf for functions Rad = (n * 2 * 3.1416) / 360 End Function ' Convert radians to degrees Function Deg ( n As Single ) As Single ' page 83 basic.pdf for functions Deg = (360 * n) / (2 * 3.1416) End Function ' CLS ~ clear the screen area and pause for it to take effect ' ' ------------------------------------------------------------------------- ' NOTES: on animation in DeltaCAD ' ' 1. The best way would be to use LAYERS and to have the default layer ' hold the hour and calendar lines, and the box, and a second layer ' to hold the gnomon shadow. Unfortunatley, while you can easily ' delete a layer in DeltaCAD, not so easy in a script. And the next ' LAYER method is to have a new layer per shadow, and turn prior layers ' off, however than can consume expensive resources. ' 2. The next best method would be to delete shadow lines by re-drawing ' them with a null color, but DeltaCAD has no ability to undraw a ' line. ' 3. So we could re-draw the lines as white lines, but that would place ' white lines over existing hour lines and damage them, but it works. ' 4. Or we could make the shadow lines unique by color, type, or thickness ' and then run all objects looking for the unique type and delete that ' object. That works but dcGetLineParms doesnt always return the ' info we need, hence why we must use dcGetLineData, however that has ' its own quirks. ' 5. Regardless of the method used, it appears that actual drawing and ' displaying are asynchronous with the dc commands or functions. ' Hence... lines still seem to be cloberred ' Hence... sometimes the drawing stops until the end if the ' computer is busy. Happens if any programs are open even ' if they are not doing anything. ' So, "yer pays yer money and takes yer choice" ' ------------------------------------------------------------------------- ' Function cls Dim i As Single Dim j As Single ' pause ' this is bad coding practice ~ using one variable for two different uses i = Timer * 100 ' i is in 1/100 of a Second j = i+2 ' j is 2/100 into the future Do While i < j j=j ' do nothing i = Timer * 100 ' get the time again Loop ' try anything that works To Erase the screen If (dcSelectObjInBox (-5, -5, 5, 5) ) Then dcEraseSelObjs ElseIf (dcSelectAll) Then dcEraseSelObjs End If For i = 1 To 500 Step 1 dcSetLineParms dcWHITE,dcSOLID,dcTHICK dcCreateLine -2,(i-250)/100, 2, (i-250)/100 Next i If (dcSelectObjInBox (-5, -5, 5, 5) ) Then dcEraseSelObjs ElseIf (dcSelectAll) Then dcEraseSelObjs End If End Function ' *** END ***