'********************************************************
'* SDBOXHM.bas is a DeltaCad macro for producing a *
'* Pocket Folding Box Horizontal Altitude Sundial for a *
'* Separate Month with Longitude and EOT Corrections. *
'* Created by Valentin Hristov (valhrist@bas.bg, *
'* www.math.bas.bg/complan/valhrist/mystuff.htm). *
'* 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. *
'********************************************************
'* January 2008 - Modification of my previous macro sdboxh.bas which
'* shows a whole year. The month output is better for separation of the
'* hour lines.
'* 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.
'* The red crosses outside are the vertices of the main rectangle for
'* an origami design which can be applied. It can found in the file
'* http://www.origamiaustria.at/diagrams/simple_box.pdf.
'* Do not cut inside this rectangle if you want to apply this design.
'* 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
dcSetSplineParms 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,count,m as Double
Dim decl(366),eot(366),spl(732) As Double
Dim nl,be,en 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,118, "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, "Month (1=Jan,...,12=Dec)"
Text 15,80,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,88,30,10, .feot
TextBox 155,88,30,10, .flon
TextBox 155,56,30,10, .nl
TextBox 155,68,30,10, .m
OKButton 82,102,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.m = 1 'Month
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
If test("m",prompt.m,1,12) = 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
m=prompt.m
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)=.367402-23.275*cos(w+.178044)-.38506*cos(2*w+.0687076)-.16046*cos(3*w+.451301)+.00315469*cos(4*w+.876643)
next count
decl(366)=decl(1)
for count=1 to 365
w=.017202792*(count-(cm-15)/360)
eot(count)=.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 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"
datetext( 1) = "JANUARY"
datetext( 2) = "FEBRUARY"
datetext( 3) = "MARCH"
datetext( 4) = "APRIL"
datetext( 5) = "MAY"
datetext( 6) = "JUNE"
datetext( 7) = "JULY"
datetext( 8) = "AUGUST"
datetext( 9) = "SEPTEMBER"
datetext(10) = "OCTOBER"
datetext(11) = "NOVEMBER"
datetext(12) = "DECEMBER"
datetext(13) = "JANUARY"
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, dcSolid, dcThin
for y=-3.5 to 3.5 step 7
for x=-2 to 2
dcCreateline x-.1,y,x+.1,y
dcCreateline x,y-.1,x,y+.1
next x
next y
dcSetLineParms dcRED, dcSolid, dcThin
for y=-3.5 to 3.5 step 7
for x=-3 to 3 step 6
dcCreateline x-.1,y,x+.1,y
dcCreateline x,y-.1,x,y+.1
next x
next y
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: valhrist@bas.bg"
dcSetTextParms dcBlack,"Tahoma","Standard",90,8,21,0,0
dcCreateText 2.7,0,0,"Web page: www.math.bas.bg/complan/valhrist/mystuff.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."
dcSetTextParms dcBlue,"Tahoma","Standard",0,8,21,0,0
dcCreateText 0,2.43,0,"Civil (Winter) time"
dcCreateText 0,-.07,0,"CiviQu1z[LʡxN
.,6MK)6rNUW*YqOIw1u6S{i֭Yep^7
#mN7vv~̌)шZ+-4e)|Y,`
d[#Bi{J8B.o_*/-ػeR;2?=if.lrq$P 3U#ƧsDa氚@cY H\%Lwn(c%*W;/t^<7e&@C32bQڵ@*M̹z^Ta+G%I{+,_L..ry]֓ݑ=41y8&nM=qH}C0 a%:~1'̧D64RXבg?ӭ0ȯ|
AҰėd]%%`ncx-.ZfTN6= f0/jL-t -|Kd66'
abCnŊ(h=>85<
9ɹደګi O]fZ4oΗn>^ 8t4Ny4%"ͥwQ~ &)#Pcw
@ƇވܙK9P*'?;'H7m
Yv_YuN?Ø߀Ъ!7!m{ӧHݻ41nA+9d̓#s|1[Nj{Hf