!#Technologická
!#ICONAME 
!#TYPE 2
!#AUTOLOAD F
macro TRUBKOVNI \'Trubkovnice'\ 'tr' (real d1\'Průměr trubkovnice'\,                t1\'Rozteč'\,naj\'najetí nad materiál'\,sp\'souřadnice přejezdu'\,          hl\'souřadnice vrtání'\,posu\'posuv'\;integer                               nn1\'Vtání od bodu číslo'\,nn2\'Vtání do bodu číslo'\)

 integer n1,n2,j1,j2
 real t2,d2
 xy
 d2=prumn
 n1=int((d1/2-d2/2)/t1)
 t2=t1/2/tan(30)
 n2=int((d1/2-d2/2)/t2)
 mb,'m',0
 k,1,1,0,d1/2
 for j2=1 to (2*n2+1)
  for j1=1 to (2*n1+2)
   if j2/2>int(j2/2) then
    b,100,1,0,-n1*t1+t1*(j1-1),n2*t2-t2*(j2-1)
   else
    b,100,1,0,n1*t1-t1*(j1-.5),n2*t2-t2*(j2-1)
   endif
   if vzd(100,0)+d2/2<d1/2 then
    mb,'m','m',100
   endif
  next
 next
 mzm,'m',2..dem('m')
 if nn1<1 then
  halt,'Číslo prvního bodu musí bít >0'
 endif
 if nn1>nn2 then
  halt,'Číslo prvního bodu musí bít < než číslo posledního bodu'
 endif
 if nn1>dem('m') then
  halt,'Číslo prvního bodu je > než celkový počet bodů, už není co vrtat'
 endif
 if dem('m')<nn2 then
  mzm,'m',nn1..dem('m')
 else
  mzm,'m',nn1..nn2
 endif
 apl vrt,naj,hl,sp,posu
 poz,'m'
endmac
macro vrt(real rs\'3. souradnice rychloposuvem'\,                                         pp\'3. souradnice posuvem'\, sv\'souradnice vyjeti'\,                       ps\'posuv'\)

  ref,rs 
  ref,pp,ps
  ref,sv
endmac
macro SROUBZAV \'Zavrtání po šroubovici'\ 'dd'(real                                             xs\'X středu'\,                                                             ys\'Y středu'\,                                                             zn\'Z najetí'\,                                                             zz\'Z začátku šroubovice'\,                                                 zd\'Z dna šroubovice'\,                                                     dd\'průměr otvoru'\,                                                        uh\'úhel sestupu'\,                                                         ps\'posuv'\;real                                                            nv\'největší zanedbávaný vrchlík'\,                                         nuh\'největší zanedbávaný úhel'\;symb                                       zar\'zarovnat dno [Y,N]'\[Y,N],                                             smer\'ve směru hodin [Y,N]'\[Y,N],                                          naje\'nájezd od středu [Y,N]'\[Y,N],                                        odje\'odjezd do středu [Y,N]'\[Y,N])

 integer ii,nn
 real alfa,dn,xxx,yyy,zzz,duh
 xy

 dn=dd-prumn
 if dn<=0 then
  halt,'Průměr otvoru musí být větší než průměr nástroje'
 endif
 alfa=abs(zz-zd)/abs(pi*dn*tan(uh))*360
 duh=2*acos(1-nv/dn/2)
 if duh>nuh then
  duh=nuh
 endif
 nn=int(alfa/duh)+1
 duh=alfa/nn
 if smer=y then
  duh=-duh
 endif
 if naje=y then
  pri,xs,ys,ps
 else
  pri,xs+dn/2,ys
 endif
 ref,zn
 ref,zz,ps
 if naje=y then
  pri,xs+dn/2,ys,ps
 endif
 for ii=1 to nn
  xxx=xs+dn/2*cos(ii*duh)
  yyy=ys+dn/2*sin(ii*duh)
  zzz=zz-ii*(zz-zd)/nn
  p3d,xxx,yyy,zzz,ps
 next
 if zar=y then
  k,1,1,0,dn/2
  b,1,1,0,xxx,yyy
  b,2,1,0,-xxx,-yyy
  pv,'1',1,k1,2,k1,u
  po,'1',xs,ys,0,0,'1'
  if smer=y then
   op,'1','1'
  endif
  kon,'1',0,0,zd,1,3,ps#2,0,0,s
 endif
 if odje=y then
  pri,xs,ys,ps
 endif
! ref,zn
endmac
macro KYVZAV \'Kývavé zavrtání'\ 'dd'(real xsz\'X středu začátku'\,                                 ysz\'Y středu začátku'\,                                                    xsk\'X středu konce'\,                                                      ysk\'Y středu konce'\,                                                      zn\'Z najetí'\,                                                             zz\'Z začátku drážky'\,                                                     zd\'Z dna drážky'\,                                                         uh\'max. úhel sestupu'\,                                                    ps\'posuv'\;symb                                                            zar\'zarovnat dno [Y,N]'\[Y,N])    

 integer ii,nn
 real hh
 xy
 if zn<zz then
  halt,'Z najetí nemůže být menší než Z začátku drážky'
 endif
 if zz<=zd then
  halt,'Z dna drážky musí být menší než Z začátku drážky'
 endif
 hh=tan(uh)*vzd(xsz;ysz,xsk;ysk)
 nn=int((zz-zd)/hh)
 if (zz-zd)>hh*nn then
  nn=nn+1
  hh=(zz-zd)/nn
 endif
 if (zar=n) and (nn/2<>int(nn/2)) then ! kdyz neni zarovnat tak vzdy skonci na zacatku
  nn=nn+1
  hh=(zz-zd)/nn
 endif
 p3d,xsz,ysz,z
 p3d,xsz,ysz,zn
 p3d,xsz,ysz,zz,ps
 for ii=1 to nn
  if ii/2=int(ii/2) then	!sude
   p3d,xsz,ysz,zz-ii*hh,ps
  else	!liche
   p3d,xsk,ysk,zz-ii*hh,ps
  endif
 next
 ii=nn+1
 if zar=y then
  if ii/2=int(ii/2) then	!sude
   p3d,xsz,ysz,zd,ps
  else	!liche
   p3d,xsk,ysk,zd,ps
  endif
  p3d,x,y,zn
 endif
endmac
macro ROTE \'Rotační těleso'\ 'ff' (string jp\'Jméno povrchu'\;real                     pu\'Počáteční úhel'\,                                                       ku\'Koncový úhel'\,                                                         uk\'Úhlový krok třískování'\,                                               ff1\'Posuv pro frézování podél'\,                                           ff2\'Posuv pro přejíždění'\,                                                nv\'Největší zanedbávaný vrchlík'\,                                         nuh\'Největší zanedbávaný úhel'\;symb                                       slp\'Ekvidistanta L..vlevo, P..vpravo, S..středem'\[s,l,p])

 integer nn,ii,jj
 real xx,yy,zz
 xy
 nn=int(abs(int((pu-ku)/uk)))
 if nn/2<>int(nn/2) then
  nn=nn+1
  uk=abs((pu-ku)/nn)
 endif
 if slp<>s then
  ek,jp,5,slp,jp
 endif
 DELOB,jp,jp,nv,nuh
 p3d,sb(bzp(jp,1),1),sb(bzp(jp,1),2),0
 for ii=0 to int(nn/2)
  for jj=1 to dep(jp)
   xx=sb(bzp(jp,jj),1)
   yy=sb(bzp(jp,jj),2)*cos(pu+ii*uk)
   zz=sb(bzp(jp,jj),2)*sin(pu+ii*uk)-5!prumnas/2
   if jj=1 then
    p3d,xx,yy,zz,ff2
   else
    p3d,xx,yy,zz,ff1
   endif
  next
  for jj=dep(jp) to 1 step-1
   xx=sb(bzp(jp,jj),1)
   yy=sb(bzp(jp,jj),2)*cos(ku-ii*uk)
   zz=sb(bzp(jp,jj),2)*sin(ku-ii*uk)-5!prumnas/2
   if jj=dep(jp) then
    p3d,xx,yy,zz,ff2
   else
    p3d,xx,yy,zz,ff1
   endif
  next
 next
endmac
macro PROFB \'Profil boku'\ 'ff' (string jp\'Jméno povrchu'\,                       pb\'Jméno povrchu boku'\;real                                               dd\'Délka úsečky pro třískování'\,                                          ff\'Posuv'\;point                                                           bna\'Bod nájezdu'\;symb                                                     slp\'Ekvidistanta tvaru L..vlevo, P..vpravo'\[l,p],                         slpb\'Ekvidistanta boku L..vlevo, P..vpravo, S..středem'\[s,l,p])

 integer ii
 real zz
 xy
 zz=z
 if slpb<>s then
  ek,pb,prumn/2,slpb,pb
 endif
 DELD,pb,pb,dd
 p3d,sb(bna,1),sb(bna,2),zz
 p3d,x,y,sb(bzp(pb,1),2)-prumn/2
 for ii=1 to dep(pb)
  ek,jp,sb(bzp(pb,ii),1),slp,'pp'
  p3d,sb(bzp('pp',1),1),sb(bzp('pp',1),2),z,ff		!najeti
  kon,'pp',0,0,z,1,dep('pp'),ff#dep('pp')-1,0,0,s
  p3d,sb(bna,1),sb(bna,2),z,ff								!vyjeti
  p3d,x,y,sb(bzp(pb,ii),2)-prumn/2
 next
 p3d,x,y,zz
endmac