REM This CADL file will write balloons, a BOM table & text entries. 
REM The balloon drawing code is a sub-set of a cadl written by Kevin Keur, kkbulldog@aol.com 
REM All praise for that aspect of this program should go to him! 

REM P. Nelson 1998, sdd@cobweb.com.au 
REM Revised by R. Lear 1999, qdsjesup@aol.com


clear 

:begin 

clear x1, x2, y1, y2, aa, bb, cc, th, cn, an, $ival, bn, nt 
clear br, nh, asz, ast, nc, ps, bsty, st


REM *** br=balloon radius, bc=balloon colour, nh=note height *** 
REM *** nc=note colour, lc=leader colour, asz=arrow size, ast=arrow style *** 
REM *** ps=print scale, bsty=balloon style, st=stacked balloon ***

defscale=1
GETFLT "Enter drawing scale (%f) =>", defscale, ps
IF (@key==-3)
GOTO end
IF (@key==-2)
GOTO begin
br=.25/ps
bc=9
nh=.125/ps
nc=9
lc=9 
asz=.18/ps
ast=1

REM *** a=item line pos., b=item text pos., e=desc. line pos, f=desc text pos 
REM *** g=size line pos, h=size text pos, i=matl. line pos, j=matl. text pos 
REM *** m=qty line pos, n=qty text pos, k=treat line pos, l=treat text pos 
REM *** c=sheet line pos, d=sheet text pos, o=pur. line pos., p=pur. text pos

a=8/ps 
b=7.9/ps 
c=7.42/ps 
d=7.32/ps 
e=6.84/ps 
f=6.74/ps 
g=4.94/ps
h=4.84/ps 
i=1.85/ps 
j=1.82/ps 
k=1.25/ps 
l=1.22/ps 
m=.5/ps 
n=.45/ps 
o=.875/ps 
p=.844/ps
SET gridinc, br, br
SET snapinc, br, br
SET grid, 2

defopt=1 
getmenu "Start a table, add to a table or edit ?","Start","Add","Edit","Menu" 

if (@key ==-3) 
goto end 
if (@key ==-2) 
goto begin 
if (@key ==-1) 
goto begin 
if (@key ==1) 
goto starttable 
if (@key ==2) 
goto addtable 
if (@key ==3) 
goto editline 
if (@key ==4) 
goto end 

REM *** START A TABLE *** 

:starttable 

q=1 

:startloop 

defopt=1 
getmenu "Draw a balloon ?","Yes","No" 

if (@key ==-3) 
goto end 
if (@key ==-2) 
goto begin 
if (@key ==-1) 
goto startloop 
if (@key ==2) 
goto startredo 

GETMENU "Select balloon style, or <ENTER>...", "Single", "Split", , , , , , , , 1 
IF (@key==1)
bsty=1
IF (@key==2)
bsty=2
IF (@key==-3)
GOTO end
IF (@key==-2)
GOTO begin
GETMENU "Stacked balloon?", "Yes", "No", , , , , , , , , 2
IF (@key==2)
st=0
IF (@key==1)
st=1
IF (@key==-3)
GOTO end
IF (@key==-2)
GOTO begin
IF (st==1)
goto startloop2
SET snap, 0

GETPOS "Select ARROW location...", 1 
IF (@key==-3) 
GOTO end 
IF (@key==-2) 
GOTO begin 
IF (@key==-1) 
GOTO end 
x1=@xview 
y1=@yview 

:startloop2 

SET snap, 1
GETPOS "Select BALLOON location...", 1 
IF (@key==-3) 
GOTO end 
IF (@key==-2) 
GOTO startloop 
IF (@key==-1) 
GOTO startloop2 
x2=@xview 
y2=@yview 
IF (st==1) 
GOTO stack1 
aa=x2-x1 
IF (aa==0) 
aa=.00001 
bb=y2-y1 
cc=sqrt((aa*aa)+(bb*bb)) 
th=atan(bb/aa) 
cn=cc-br 
an=(cos(th))*cn 
bn=(sin(th))*cn 
:stack1 
SPRINT $ival, "%d", q 
CALL strlen, $ival, nt 
IF (nt==1) 
nt=nh*.4 
IF (nt==2) 
nt=nh*.8 
IF (nt==3) 
nt=nh*1.2 
IF (nt==4) 
nt=nh*1.6 
IF (st==1)
GOTO stack2
IF (aa<0) 
GOTO startnext 
SET collect, 1 
LEADER (an+x1), (bn+y1), x1, y1, asz, ast, 0, lc, 0, 1, 0, 0, 0 
:stack2
CIRCLE x2, y2, 0, br, 0, bc, 0, 1, 0, 0, 0, 0 
IF (bsty==2)
LINE x2-br, y2, 0, x2+br, y2, 0, bc 
IF (bsty==1)
NOTE x2-nt, y2-(nh/2), $ival, 0, nh, .8, 0, nc, 0, 0, 0, 0, 0, 0, 0, .6, 0, 0 
IF (bsty==2) 
NOTE x2-nt, y2-(nh/2)+(br/2)-.02, $ival, 0, nh, .8, 0, nc, 0, 0, 0, 0, 0, 0, 0, .6, 0, 0 
IF (bsty==1) 
GOTO startredo
GETSTR "Enter bottom character...", "1", $note2 
CALL strlen, $note2, nt2 
IF (nt2==1) 
nt2=nh*.4 
IF (nt2==2) 
nt2=nh*.8 
IF (nt2==3) 
nt2=nh*1.2 
IF (nt2==4) 
nt2=nh*1.6 
IF (bsty==2) 
NOTE x2-nt2, y2-(nh/2)-(br/2)+.02, $note2, 0, nh, .8, 0, nc, 0, 0, 0, 0, 0, 0, 0, .6, 0, 0 
goto startredo 

:startnext 
SET collect, 1 
LEADER (x1-an), (y1-bn), x1, y1, asz, ast, 0, lc, 0, 1, 0, 0, 0 
CIRCLE x2, y2, 0, br, 0, bc, 0, 1, 0, 0, 0, 0 
IF (bsty==2) 
LINE x2-br, y2, 0, x2+br, y2, 0, bc 
IF (bsty==1) 
NOTE x2-nt, y2-(nh/2), $ival, 0, nh, .8, 0, nc, 0, 0, 0, 0, 0, 0, 0, .6, 0, 0 
IF (bsty==2) 
NOTE x2-nt, y2-(nh/2)+(br/2)-.02, $ival, 0, nh, .8, 0, nc, 0, 0, 0, 0, 0, 0, 0, .6, 0, 0 
IF (bsty==1) 
GOTO startredo
GETSTR "Enter bottom character...", "1", $note2 
CALL strlen, $note2, nt2 
IF (nt2==1) 
nt2=nh*.4 
IF (nt2==2) 
nt2=nh*.8 
IF (nt2==3) 
nt2=nh*1.2 
IF (nt2==4) 
nt2=nh*1.6 
IF (bsty==2) 
NOTE x2-nt2, y2-(nh/2)-(br/2)+.02, $note2, 0, nh, .8, 0, nc, 0, 0, 0, 0, 0, 0, 0, .6, 0, 0 
goto startredo 

:startredo 

SET collect, 0 

if q > 1.1 
goto startmultiloop 

defopt=3 
getpos "Select the position of the bottom right corner", defopt 

if (@key ==-3) 
goto end 
if (@key ==-2) 
goto starttable 
if (@key ==-1) 
goto starttable 

REM *** datum positions for the table lines (x3,y3) & the text (xt,yt) *** 

x3=@xcview 
y3=@ycview 
xt=@xcview 
yt=@ycview 

set collect, 1 

REM *** draw table horizontal line 

vline x3-a, y3+(.3/ps), 0, x3, y3+(.3/ps), 0, 0, 14, 0, 1, 0, 0, 0 , 0 

REM *** draw table vertical lines *** 

vline x3-a, y3, 0, x3-a, y3+(.3/ps), 0, 0, 14, 0, 1, 0, 0, 0, 0 
vline x3-e, y3, 0, x3-e, y3+(.3/ps), 0, 0, 14, 0, 1, 0, 0, 0, 0 
vline x3-g, y3, 0, x3-g, y3+(.3/ps), 0, 0, 14, 0, 1, 0, 0, 0, 0 
vline x3-i, y3, 0, x3-i, y3+(.3/ps), 0, 0, 14, 0, 1, 0, 0, 0, 0 
vline x3-m, y3, 0, x3-m, y3+(.3/ps), 0, 0, 14, 0, 1, 0, 0, 0, 0 
vline x3-k, y3, 0, x3-k, y3+(.3/ps), 0, 0, 14, 0, 1, 0, 0, 0, 0 
vline x3-c, y3, 0, x3-c, y3+(.3/ps), 0, 0, 14, 0, 1, 0, 0, 0, 0 
vline x3-o, y3, 0, x3-o, y3+(.3/ps), 0, 0, 14, 0, 1, 0, 0, 0, 0 

set collect, 0 

REM *** write column headings *** 

set collect, 1 

note xt-b, yt+(.08/ps), "ITEM", 0, .125/ps, .7, 0, 14, 0, 0 
note xt-f, yt+(.08/ps), "DESCRIPTION", 0, .125/ps, .7, 0, 14, 0, 0 
note xt-h, yt+(.08/ps), "MATERIAL SIZE", 0, .125/ps, .7, 0, 14, 0, 0 
note xt-j, yt+(.08/ps), "MAT'L.", 0, .125/ps, .7, 0, 14, 0, 0 
note xt-n, yt+(.08/ps), "QTY.", 0, .125/ps, .7, 0, 14, 0, 0 
note xt-l, yt+(.08/ps), "HDN.", 0, .125/ps, .7, 0, 14, 0, 0 
note xt-d, yt+(.08/ps), "SHT.", 0, .125/ps, .7, 0, 14, 0, 0 
note xt-p, yt+(.08/ps), "PUR.", 0, .125/ps, .7, 0, 14, 0, 0 

set collect, 0 

y3=y3+(.3/ps) 
yt=yt+(.3/ps) 

:startmultiloop 

set collect, 1 

REM *** draw table horizontal line 

vline x3-a, y3+(.3/ps), 0, x3, y3+(.3/ps), 0, 0, 14, 0, 1, 0, 0, 0 , 0 

REM *** draw table vertical lines *** 

vline x3-a, y3, 0, x3-a, y3+(.3/ps), 0, 0, 14, 0, 1, 0, 0, 0, 0 
vline x3-e, y3, 0, x3-e, y3+(.3/ps), 0, 0, 14, 0, 1, 0, 0, 0, 0 
vline x3-g, y3, 0, x3-g, y3+(.3/ps), 0, 0, 14, 0, 1, 0, 0, 0, 0 
vline x3-i, y3, 0, x3-i, y3+(.3/ps), 0, 0, 14, 0, 1, 0, 0, 0, 0 
vline x3-m, y3, 0, x3-m, y3+(.3/ps), 0, 0, 14, 0, 1, 0, 0, 0, 0 
vline x3-k, y3, 0, x3-k, y3+(.3/ps), 0, 0, 14, 0, 1, 0, 0, 0, 0 
vline x3-c, y3, 0, x3-c, y3+(.3/ps), 0, 0, 14, 0, 1, 0, 0, 0, 0 
vline x3-o, y3, 0, x3-o, y3+(.3/ps), 0, 0, 14, 0, 1, 0, 0, 0, 0 

set collect, 0 

set collect, 1 

REM *** write table entries *** 
REM *** write item number *** 

sprint $table1, "%.f", q 
note xt-b, (yt+(.08/ps)), $table1, 0, .125/ps, .7, 0, 9, 0, 0, 0, 0, 0, 0, 0, 1.0, 0, 0 

REM *** write description *** 

$desc_def=" " 
getstr "Enter a description ..>", $desc_def, $desc 
note xt-f, (yt+(.08/ps)), $desc, 0, .125/ps, .7, 0, 9, 0, 0, 0, 0, 0, 0, 0, 1.0, 0, 0 

REM *** write size *** 

:startlinesize 

defopt=1 
getmenu "Enter size by entry, picking points or skip","Enter","Pick","Skip" 

if (@key ==-3) 
goto end 
if (@key ==-2) 
goto startlinesize 
if (@key ==-1) 
goto startlinesize 
if (@key ==2) 
goto startlinepick 
if (@key ==3) 
goto startlinenext 

$size_def=" " 
getstr "Enter size ..>", $size_def, $size 
note xt-h, (yt+(.08/ps)), $size, 0, .125/ps, .7, 0, 9, 0, 0, 0, 0, 0, 0, 0, 1.0, 0, 0 
goto startlinenext 

:startlinepick 

clear px1, px2, px3, px4, px5, px6, r, s, t, u, v, w 

rem *** select 3 sets of 2 points for item dimensions *** 

defopt=3 
getpos "The first pair of positions - select first position", defopt 

px1 = @xcview 
py1 = @ycview 

defopt=3 
getpos "The first pair of positions - select second position", defopt 

px2 = @xcview 
py2 = @ycview 

r = sqrt( (px1-px2)^2 + (py1-py2)^2 ) 

defopt=3 
getpos "The second pair of positions - select first position", defopt 

px3 = @xcview 
py3 = @ycview 

defopt=3 
getpos "The second pair of positions - select second position", defopt 

px4 = @xcview 
py4 = @ycview 

s = sqrt( (px3-px4)^2 + (py3-py4)^2 ) 

defopt=3 
getpos "The last pair of positions - select first position", defopt 

px5 = @xcview 
py5 = @ycview 

defopt=3 
getpos "The last pair of positions - select second position", defopt 

px6 = @xcview 
py6 = @ycview 

t = sqrt( (px5-px6)^2 + (py5-py6)^2 ) 

REM *** round dims up to the next  .001 in. *** 

u=(ceil(r*1000))/1000 
v=(ceil(s*1000))/1000 
w=(ceil(t*1000))/1000 

sprint $dim, "%.3f X %.3f X %.3f", u, v, w 

note xt-h, (yt+(.08/ps)), $dim, 0, .125/ps, .7, 0, 9, 0, 0, 0, 0, 0, 0, 0, 1.0, 0, 0 

:startlinenext 

REM *** write material *** 

$matl_def=" " 
getstr "Enter material..>", $matl_def, $matl 
note xt-j, (yt+(.08/ps)), $matl, 0, .125/ps, .7, 0, 9, 0, 0, 0, 0, 0, 0, 0, 1.0, 0, 0 

REM *** write quantity *** 

$quan_def=" " 
getstr "Enter quantity ..>", $quan_def, $quan 
note xt-n, (yt+(.08/ps)), $quan, 0, .125/ps, .7, 0, 9, 0, 0, 0, 0, 0, 0, 0, 1.0, 0, 0 

REM *** write treatment *** 

$treat_def=" " 
getstr "Enter 'X' for heat treat ..>", $treat_def, $treat 
note (xt-l+.12), (yt+(.08/ps)), $treat, 0, .125/ps, .7, 0, 9, 0, 0, 0, 0, 0, 0, 0, 1.0, 0, 0 

REM *** write sheet no. *** 

$sheet_def=" " 
getstr "Enter sheet number ..>", $sheet_def, $sheet 
note xt-d, (yt+(.08/ps)), $sheet, 0, .125/ps, .7, 0, 9, 0, 0, 0, 0, 0, 0, 0, 1.0, 0, 0 

REM *** write pur. *** 

$pur_def=" " 
getstr "Enter 'X' for purchased ..>", $pur_def, $pur 
note (xt-p+.12), (yt+(.08/ps)), $pur, 0, .125/ps, .7, 0, 9, 0, 0, 0, 0, 0, 0, 0, 1.0, 0, 0 

set collect, 0 

:startmultiagain 

getmenu "Any more ?","Yes","No" 

if (@key ==-3) 
goto end 
if (@key ==-2) 
goto startmultiloop 
if (@key ==-1) 
goto startmultiagain 
if (@key ==2) 
goto begin 

REM *** increment the next detail no. 'q' *** 
q=q+1 
REM *** increment the y position of the next entry in the chart by one line *** 
yt=yt+(.3/ps) 
REM *** increment the y position for the table vertical lines *** 
y3=y3+(.3/ps) 
goto startloop 

REM *** ADD TO A TABLE *** 

:addtable 

REM *** Zero run-thru counter *** 
pp=0 

REM *** balloon code starts here *** 

GETflt "Enter detail number to increment from...", 1, q 
IF (@key==-3) 
GOTO end 
IF (@key==-2) 
GOTO begin 

:addloop 

defopt=1 
getmenu "Draw a balloon ?","Yes","No" 

if (@key ==-3) 
goto end 
if (@key ==-2) 
goto begin 
if (@key ==-1) 
goto addtable 
if (@key ==2) 
goto addredo 

GETMENU "Select balloon style, or <ENTER>...", "Single", "Split", , , , , , , , , 1
IF (@key==1)
bsty=1
IF (@key==2)
bsty=2
IF (@key==-3)
GOTO end
IF (@key==-2)
GOTO begin
GETMENU "Stacked balloon?", "Yes", "No", , , , , , , , , 2
IF (@key==2)
st=0
IF (@key==1)
st=1
IF (@key==-3)
GOTO end
IF (@key==-2)
GOTO begin
IF (st==1)
goto addloop2
SET snap, 0

GETPOS "Select ARROW location...", 1 
IF (@key==-3) 
GOTO end 
IF (@key==-2) 
GOTO begin 
IF (@key==-1) 
GOTO end 
x1=@xview 
y1=@yview 

:addloop2 

SET snap, 1
GETPOS "Select BALLOON location...", 1 
IF (@key==-3) 
GOTO end 
IF (@key==-2) 
GOTO addloop 
IF (@key==-1) 
GOTO addloop2 
x2=@xview 
y2=@yview 
IF (st==1) 
GOTO addstack1
aa=x2-x1 
IF (aa==0) 
aa=.00001 
bb=y2-y1 
cc=sqrt((aa*aa)+(bb*bb)) 
th=atan(bb/aa) 
cn=cc-br 
an=(cos(th))*cn 
bn=(sin(th))*cn 
:addstack1
SPRINT $ival, "%d", q 
CALL strlen, $ival, nt 
IF (nt==1) 
nt=nh*.4 
IF (nt==2) 
nt=nh*.8 
IF (nt==3) 
nt=nh*1.2 
IF (nt==4) 
nt=nh*1.6  
IF (st==1) 
GOTO addstack2 
IF (aa<0)
GOTO addnext 
SET collect, 1 
LEADER (an+x1), (bn+y1), x1, y1, asz, ast, 0, lc, 0, 1, 0, 0, 0 
:addstack2 
CIRCLE x2, y2, 0, br, 0, bc, 0, 1, 0, 0, 0, 0 
IF (bsty==2) 
LINE x2-br, y2, 0, x2+br, y2, 0, bc 
IF (bsty==1) 
NOTE x2-nt, y2-(nh/2), $ival, 0, nh, .8, 0, nc, 0, 0, 0, 0, 0, 0, 0, .6, 0, 0 
IF (bsty==2) 
NOTE x2-nt, y2-(nh/2)+(br/2)-.02, $ival, 0, nh, .8, 0, nc, 0, 0, 0, 0, 0, 0, 0, .6, 0, 0 
IF (bsty==1) 
GOTO addredo
GETSTR "Enter bottom character...", "1", $note2 
CALL strlen, $note2, nt2 
IF (nt2==1) 
nt2=nh*.4 
IF (nt2==2) 
nt2=nh*.8 
IF (nt2==3) 
nt2=nh*1.2 
IF (nt2==4) 
nt2=nh*1.6 
IF (bsty==2) 
NOTE x2-nt2, y2-(nh/2)-(br/2)+.02, $note2, 0, nh, .8, 0, nc, 0, 0, 0, 0, 0, 0, 0, .6, 0, 0 
goto addredo 

:addnext 
SET collect, 1 
LEADER (x1-an), (y1-bn), x1, y1, asz, ast, 0, lc, 0, 1, 0, 0, 0 
CIRCLE x2, y2, 0, br, 0, bc, 0, 1, 0, 0, 0, 0 
IF (bsty==2) 
LINE x2-br, y2, 0, x2+br, y2, 0, bc 
IF (bsty==1) 
NOTE x2-nt, y2-(nh/2), $ival, 0, nh, .8, 0, nc, 0, 0, 0, 0, 0, 0, 0, .6, 0, 0 
IF (bsty==2) 
NOTE x2-nt, y2-(nh/2)+(br/2)-.02, $ival, 0, nh, .8, 0, nc, 0, 0, 0, 0, 0, 0, 0, .6, 0, 0 
IF (bsty==1) 
GOTO addredo
GETSTR "Enter bottom character...", "1", $note2 
CALL strlen, $note2, nt2 
IF (nt2==1) 
nt2=nh*.4 
IF (nt2==2) 
nt2=nh*.8 
IF (nt2==3) 
nt2=nh*1.2 
IF (nt2==4) 
nt2=nh*1.6 
IF (bsty==2) 
NOTE x2-nt2, y2-(nh/2)-(br/2)+.02, $note2, 0, nh, .8, 0, nc, 0, 0, 0, 0, 0, 0, 0, .6, 0, 0 
goto addredo 

:addredo 

if pp >= 1 
goto addmultiloop 

SET collect, 0 

defopt=3 
getpos "Select the position of the bottom right corner", defopt 

if (@key ==-3) 
goto end 
if (@key ==-2) 
goto addtable 
if (@key ==-1) 
goto addtable 

REM *** datum positions for the table lines (x3,y3) & the text (xt,yt) *** 

x3=@xcview 
y3=@ycview 
xt=@xcview 
yt=@ycview 

:addmultiloop 

set collect, 1 

REM *** draw table horizontal line 

vline x3-a, y3+(.3/ps), 0, x3, y3+(.3/ps), 0, 0, 14, 0, 1, 0, 0, 0 , 0 

REM *** draw table vertical lines *** 

vline x3-a, y3, 0, x3-a, y3+(.3/ps), 0, 0, 14, 0, 1, 0, 0, 0, 0 
vline x3-e, y3, 0, x3-e, y3+(.3/ps), 0, 0, 14, 0, 1, 0, 0, 0, 0 
vline x3-g, y3, 0, x3-g, y3+(.3/ps), 0, 0, 14, 0, 1, 0, 0, 0, 0 
vline x3-i, y3, 0, x3-i, y3+(.3/ps), 0, 0, 14, 0, 1, 0, 0, 0, 0 
vline x3-m, y3, 0, x3-m, y3+(.3/ps), 0, 0, 14, 0, 1, 0, 0, 0, 0 
vline x3-k, y3, 0, x3-k, y3+(.3/ps), 0, 0, 14, 0, 1, 0, 0, 0, 0 
vline x3-c, y3, 0, x3-c, y3+(.3/ps), 0, 0, 14, 0, 1, 0, 0, 0, 0 
vline x3-o, y3, 0, x3-o, y3+(.3/ps), 0, 0, 14, 0, 1, 0, 0, 0, 0 

set collect, 0 

set collect, 1 

REM *** write table entries *** 
REM *** write item number *** 

sprint $table1, "%.f", q 
note xt-b, (yt+(.08/ps)), $table1, 0, (.125/ps), .7, 0, 9, 0, 0, 0, 0, 0, 0, 0, 1.0, 0, 0 

REM *** write description *** 

$desc_def=" " 
getstr "Enter a description ..>", $desc_def, $desc 
note xt-f, (yt+(.08/ps)), $desc, 0, (.125/ps), .7, 0, 9, 0, 0, 0, 0, 0, 0, 0, 1.0, 0, 0 

REM *** write size *** 

:addlinesize 

defopt=1 
getmenu "Enter size by entry, picking points or skip","Enter","Pick","Skip" 

if (@key ==-3) 
goto end 
if (@key ==-2) 
goto addlinesize 
if (@key ==-1) 
goto addlinesize 
if (@key ==2) 
goto addlinepick 
if (@key ==3) 
goto addlinenext 

$size_def=" " 
getstr "Enter size ..>", $size_def, $size 
note xt-h, (yt+(.08/ps)), $size, 0, (.125/ps), .7, 0, 9, 0, 0, 0, 0, 0, 0, 0, 1.0, 0, 0 
goto addlinenext 

:addlinepick 

clear px1, px2, px3, px4, px5, px6, r, s, t, u, v, w 

rem *** select 3 sets of 2 points for item dimensions *** 

defopt=3 
getpos "The first pair of positions - select first position", defopt 

px1 = @xcview 
py1 = @ycview 

defopt=3 
getpos "The first pair of positions - select second position", defopt 

px2 = @xcview 
py2 = @ycview 

r = sqrt( (px1-px2)^2 + (py1-py2)^2 ) 

defopt=3 
getpos "The second pair of positions - select first position", defopt 

px3 = @xcview 
py3 = @ycview 

defopt=3 
getpos "The second pair of positions - select second position", defopt 

px4 = @xcview 
py4 = @ycview 

s = sqrt( (px3-px4)^2 + (py3-py4)^2 ) 

defopt=3 
getpos "The last pair of positions - select first position", defopt 

px5 = @xcview 
py5 = @ycview 

defopt=3 
getpos "The last pair of positions - select second position", defopt 

px6 = @xcview 
py6 = @ycview 

t = sqrt( (px5-px6)^2 + (py5-py6)^2 ) 

REM *** round dims up to the next .001 in. *** 

u=(ceil(r*1000))/1000 
v=(ceil(s*1000))/1000 
w=(ceil(t*1000))/1000 

sprint $dim, "%.3f X %.3f X %.3f", u, v, w 

note xt-h, (yt+(.08/ps)), $dim, 0, (.125/ps), .7, 0, 9, 0, 0, 0, 0, 0, 0, 0, 1.0, 0, 0 

:addlinenext 

REM *** write material *** 

$matl_def=" " 
getstr "Enter material..>", $matl_def, $matl 
note xt-j, (yt+(.08/ps)), $matl, 0, (.125/ps), .7, 0, 9, 0, 0, 0, 0, 0, 0, 0, 1.0, 0, 0 

REM *** write quantity *** 

$quan_def=" " 
getstr "Enter quantity ..>", $quan_def, $quan 
note xt-n, (yt+(.08/ps)), $quan, 0, (.125/ps), .7, 0, 9, 0, 0, 0, 0, 0, 0, 0, 1.0, 0, 0 

REM *** write treatment *** 

$treat_def=" " 
getstr "Enter 'X' for heat treat ..>", $treat_def, $treat 
note (xt-l+.12), (yt+(.08/ps)), $treat, 0, (.125/ps), .7, 0, 9, 0, 0, 0, 0, 0, 0, 0, 1.0, 0, 0 

REM *** write sheet no. *** 

$sheet_def=" " 
getstr "Enter sheet number ..>", $sheet_def, $sheet 
note xt-d, (yt+(.08/ps)), $sheet, 0, (.125/ps), .7, 0, 9, 0, 0, 0, 0, 0, 0, 0, 1.0, 0, 0 

REM *** write pur. *** 

$pur_def=" " 
getstr "Enter 'X' for purchased ..>", $pur_def, $pur 
note (xt-p+.12), (yt+(.08/ps)), $pur, 0, (.125/ps), .7, 0, 9, 0, 0, 0, 0, 0, 0, 0, 1.0, 0, 0 

set collect, 0 

:addmultiagain 

getmenu "Any more ?","Yes","No" 

if (@key ==-3) 
goto end 
if (@key ==-2) 
goto addmultiloop 
if (@key ==-1) 
goto addmultiagain 
if (@key ==2) 
goto begin 

REM *** increment the next detail no. 'q' *** 
q=q+1 
REM *** increment the y position of the next entry in the chart by one line *** 
yt=yt+(.3/ps) 
REM *** increment the y position for the table vertical lines *** 
y3=y3+(.3/ps) 
REM *** increment the run-thru counter by 1 *** 
pp=pp+1 
goto addloop 

REM *** EDIT A LINE *** 

:editline 

defopt=3 
getpos "Select the bottom right corner of the line to be edited", defopt 

if (@key ==-3) 
goto end 
if (@key ==-2) 
goto begin 
if (@key ==-1) 
goto editline 

x1=@xcview 
y1=@ycview 
xt=@xcview 
yt=@ycview 

defopt=1 
getmenu "What entry do you wish to add","Desc.","Mat. Size","Matl.","Qty.","Hdn.","Sheet", "Pur." 


if (@key ==-3) 
goto end 
if (@key ==-2) 
goto editline 
if (@key ==-1) 
goto editline 
if (@key ==1) 
goto editdesc 
if (@key ==2) 
goto editsize 
if (@key ==3) 
goto editmatl 
if (@key ==4) 
goto editquan 
if (@key ==5) 
goto edittreat 
if (@key ==6) 
goto editsheet 
IF (@key==7) 
GOTO editpur

REM *** write description *** 

:editdesc 

$desc_def=" " 
getstr "Enter a description ..>", $desc_def, $desc 
note xt-f, (yt+(.08/ps)), $desc, 0, (.125/ps), .7, 0, 9, 0, 0, 0, 0, 0, 0, 0, 1.0, 0, 0 
goto editagain 

:editsize 

defopt=1 
getmenu "Enter size by entry or picking points","Enter","Pick" 

if (@key ==-3) 
goto end 
if (@key ==-2) 
goto editline 
if (@key ==-1) 
goto editsize 
if (@key ==2) 
goto editsizepick 

$size_def=" " 
getstr "Enter size ..>", $size_def, $size 
note xt-h, (yt+(.08/ps)), $size, 0, (.125/ps), .7, 0, 9, 0, 0, 0, 0, 0, 0, 0, 1.0, 0, 0 
goto editagain 

:editsizepick 

clear px1, px2, px3, px4, px5, px6, r, s, t, u, v, w 

rem *** select 3 sets of 2 points for item dimensions *** 

defopt=3 
getpos "The first pair of positions - select first position", defopt 

px1 = @xcview 
py1 = @ycview 

defopt=3 
getpos "The first pair of positions - select second position", defopt 

px2 = @xcview 
py2 = @ycview 

r = sqrt( (px1-px2)^2 + (py1-py2)^2 ) 

defopt=3 
getpos "The second pair of positions - select first position", defopt 

px3 = @xcview 
py3 = @ycview 

defopt=3 
getpos "The second pair of positions - select second position", defopt 

px4 = @xcview 
py4 = @ycview 

s = sqrt( (px3-px4)^2 + (py3-py4)^2 ) 

defopt=3 
getpos "The last pair of positions - select first position", defopt 

px5 = @xcview 
py5 = @ycview 

defopt=3 
getpos "The last pair of positions - select second position", defopt 

px6 = @xcview 
py6 = @ycview 

t = sqrt( (px5-px6)^2 + (py5-py6)^2 ) 

REM *** round dims up to the next .001 in. *** 

u=(ceil(r*1000))/1000 
v=(ceil(s*1000))/1000 
w=(ceil(t*1000))/1000 

sprint $dim, "%.3f X %.3f X %.3f", u, v, w 

note xt-h, (yt+(.08/ps)), $dim, 0, (.125/ps), .7, 0, 9, 0, 0, 0, 0, 0, 0, 0, 1.0, 0, 0 
goto editagain 

:editmatl 

REM *** write material *** 

$matl_def=" " 
getstr "Enter material..>", $matl_def, $matl 
note xt-j, (yt+(.08/ps)), $matl, 0, (.125/ps), .7, 0, 9, 0, 0, 0, 0, 0, 0, 0, 1.0, 0, 0 
goto editagain 

:editquan 

REM *** write quantity *** 

$quan_def=" " 
getstr "Enter quantity ..>", $quan_def, $quan 
note xt-n, (yt+(.08/ps)), $quan, 0, (.125/ps), .7, 0, 9, 0, 0, 0, 0, 0, 0, 0, 1.0, 0, 0 
goto editagain 

:edittreat 

REM *** write treatment *** 

$treat_def=" " 
getstr "Enter 'X' for heat treat ..>", $treat_def, $treat 
note (xt-l+.12), (yt+(.08/ps)), $treat, 0, (.125/ps), .7, 0, 9, 0, 0, 0, 0, 0, 0, 0, 1.0, 0, 0 
goto editagain 

:editsheet 

REM *** write sheet no. *** 

$sheet_def=" " 
getstr "Enter sheet number ..>", $sheet_def, $sheet 
note xt-d, (yt+(.08/ps)), $sheet, 0, (.125/ps), .7, 0, 9, 0, 0, 0, 0, 0, 0, 0, 1.0, 0, 0 
goto editagain 

:editpur 

REM *** write pur. *** 

$pur_def=" " 
getstr "Enter 'X' for purchased ..>", $pur_def, $pur 
note (xt-p+.12), (yt+(.08/ps)), $pur, 0, (.125/ps), .7, 0, 9, 0, 0, 0, 0, 0, 0, 0, 1.0, 0, 0 
goto editagain 

:editagain 

getmenu "Edit any more ?","Yes","No" 

if (@key ==-3) 
goto end 
if (@key ==-2) 
goto editline 
if (@key ==-1) 
goto editagain 
if (@key ==1) 
goto editline 
if (@key ==2) 
goto begin 

:end 
SET snap, 0 
clear 
exit