tutor星形测头自动测孔子程序

这是一个没有任何参数询问的星形测头自动测孔子程序.该程序已在国内多家TUTOR用户中予以应用.为了表示对BBS参与人员的感谢,现将其完整的源程序公开在此,供大家研究和发展.
procedure STAR4
   real AA=90,DD,C1,C2,NN=0,TT,TR,RN=0
   real XC,YC,ZC,SA=0,EA=360,NX=0,ED
   vector VCIR
   coord XYZ,CCIR,XYZ2,XYZ3,XYZ4,XYZ5,ABC
   integer HEAD,SI,BL,PLXYZ,TIP1,TIPA,TIPB
   element EL
   dy icon "c:\wtutor\dq\kxx.bmp"
   dy ("")
   dy ("")
   dy ("")
   dy ("")
   dy ("")
   dy ("")
   dy ("")
   dy ("NC / STAR PROBE  HOLE<4> PROGRAM")
   dy ("")
   fly (off)
   mspeed 100
   no_approach
   BL=info_func (7)
   PLXYZ=info_func (8)
   if PLXYZ eq 3 then
     dy ("=== XY ===")
   end_if
   if PLXYZ eq 1 then
     dy ("=== YZ ===")
   end_if
   if PLXYZ eq 2 then
     dy ("=== ZX ===")
   end_if
   dy ("")
   delay (40)
   for I=1 to 100 by 1
     dist_approach 6.,12.
     manmove
     ncmove
     dist_approach 1.,100.
     HEAD=info_func (2)
     if NN eq 0 then
       probe (HEAD,2)
       get_position (XYZ2)
       probe (HEAD,3)
       get_position (XYZ3)
       probe (HEAD,4)
       get_position (XYZ4)
       probe (HEAD,5)
       get_position (XYZ5)
       if PLXYZ ne 1 then
         if XYZ2|x gt XYZ3|x then
           TIPA=2
           TT=XYZ2|x
         else
           TIPA=3
           TT=XYZ3|x
         end_if
         if XYZ4|x gt TT then
           TIPA=4
           TT=XYZ4|x
         end_if
         if XYZ5|x gt TT then
           TIPA=5
         end_if
         if PLXYZ eq 3 then
           TIP1=TIPA
         else
           TIPB=TIPA
         end_if
       end_if
       if PLXYZ ne 2 then
         if XYZ2|y gt XYZ3|y then
           TIPA=2
           TT=XYZ2|y
         else
           TIPA=3
           TT=XYZ3|y
         end_if
         if XYZ4|y gt TT then
           TIPA=4
           TT=XYZ4|y
         end_if
         if XYZ5|y gt TT then
           TIPA=5
         end_if
         if PLXYZ eq 1 then
           TIP1=TIPA
         else
           TIPB=TIPA
         end_if
       end_if
       if PLXYZ ne 3 then
         if XYZ2|z gt XYZ3|z then
           TIPA=2
           TT=XYZ2|z
         else
           TIPA=3
           TT=XYZ3|z
         end_if
         if XYZ4|z gt TT then
           TIPA=4
           TT=XYZ4|z
         end_if
         if XYZ5|z gt TT then
           TIPA=5
         end_if
         if PLXYZ eq 2 then
           TIP1=TIPA
         else
           TIPB=TIPA
         end_if
       end_if
       if ((TIP1 eq 2) and (TIPB eq 5)) or (TIP1 gt TIPB) then
         NX=1
         if (TIP1 eq 5) and (TIPB eq 2) then
           NX=0
         end_if
       end_if
       NN=1
       for TP=2 to 5 by 1
         probe (HEAD,TP)
         TR=info_func (4)
         RN=RN+TR
       end_for
       RN=RN/2
     end_if
     if NX eq 0 then
       SI=TIP1-1
     else
       SI=TIP1+1
     end_if
     BL=BL+1
     blknb BL
     HEAD=info_func (2)
     output off
     mcir (MEMO[BL],4) savepts
     for K=0 to 3 by 1
       if NX eq 0 then
         SI=SI+1
         if SI gt 5 then
           SI=SI-4
         end_if
       else
         SI=SI-1
         if SI eq 1 then
           SI=SI+4
         end_if
       end_if
       probe (HEAD,SI)
       get_position (XYZ)
       XC=XYZ|x
       YC=XYZ|y
       ZC=XYZ|z
       move (X=XC,Y=YC,Z=ZC)
       C1=0.5*cos (SA+K*AA)
       C2=0.5*sin (SA+K*AA)
       if PLXYZ eq 3 then
         movetf (X=XC+C1,Y=YC+C2,Z=ZC)
       end_if
       if PLXYZ eq 1 then
         movetf (X=XC,Y=YC+C1,Z=ZC+C2)
       end_if
       if PLXYZ eq 2 then
         movetf (X=XC+C2,Y=YC,Z=ZC+C1)
       end_if
     end_for
     TR=info_func (4)
     output on
     EL=MEMO[BL]
     ED=EL|dm
     MEMO[BL]|dm=ED-TR*2+RN
     output MEMO[BL]
     move (X=XC,Y=YC,Z=ZC)
   end_for
end_procedure

[ 本帖最后由 hzlyblue 于 2008-3-28 18:32 编辑 ]