home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p115 / 10.ddi / GCD4 / UPL / TOLSTK.UPL < prev    next >
Encoding:
Text File  |  1988-06-01  |  6.5 KB  |  162 lines
  1. -------------------------------------------------------------------------
  2. --TOLSTK.UPL
  3. --Program for tolerance stackup. 
  4. --The user is prompted for a series of linear dimensions. The system
  5. --will add up the dimensions' nominal values and the tolerances .
  6. --It will then produce minimum and maximum values. 
  7. --If a comma is entered, the user may then digitize more dimensions
  8. --which overlap the previous ones in the opposite direction.
  9. --The difference between the dimensions' nominal values and their
  10. --tolerances are then produced.
  11. --
  12. --This program demonstrates direct database access. It is for advanced
  13. --UPL programmers only. 
  14. --See Appendix H, Direct Database Access, for more restrictions and
  15. --other information.
  16. --====================================================================
  17. --WARNING: 
  18. --    o Computervision, a division of Prime Computer, Inc., cannot assume 
  19. --   responsibility for a part or drawing which is modified this program. 
  20. --    o The database format and the routines described in this appendix are 
  21. --   subject to change without notice.
  22. --    o Incorrext use of this information or the included intrinsic 
  23. --   procedures can damage or destroy part databases.
  24. --    o If this information changes in a new revision, programs which use 
  25. --   this information or the intrinsic procedures may not work and could 
  26. --   possibly damage your part.
  27. --======================================================================
  28.  
  29.  
  30. proc main
  31.     
  32.  --D1SubRec -----------------------------------
  33.     
  34.  --  This template holds the record definition for a D1 type 
  35.  --  subrecord.  It consists of a integer array a series of based 
  36.  --  variables.  The variables map to appropriate location in the
  37.  --  subrecord.
  38.   
  39.     integer D1SubRec(42)    --used in actual data base subrecord 
  40.                             --access calls as a buffer for the data
  41.     
  42.     coord   End1D1          @ D1SubRec + 2,\    -- END 1    of the LDIM
  43.             End2D1          @ D1SubRec + 14     -- END 2    of the LDIM
  44.     real    AngleD1         @ D1SubRec + 26 ,\  -- ANGLE
  45.             OffsetD1        @ D1SubRec + 30 ,\  -- OFFSET
  46.             AlphaSizeD1     @ D1SubRec + 34 ,\  -- ASIZE
  47.             Tol1D1          @ D1SubRec + 38 ,\  -- TOL(1)
  48.             Tol2D1          @ D1SubRec + 42 ,\  -- TOL(2)
  49.             TextHgtD1       @ D1SubRec + 46 ,\  -- THGT
  50.             ScaleD1         @ D1SubRec + 50     -- SCL
  51.     integer TypeD1          @ D1SubRec + 62 ,\  -- 1-HOR 2-VER 3-PPNT
  52.             ArrowsInOutD1   @ D1SubRec + 64 ,\  -- 1-AI  2-AO
  53.             DimTypeD1       @ D1SubRec + 66 ,\  -- 1-JIS 2-ANSI
  54.             AlignmentD1     @ D1SubRec + 68 ,\  -- 1-ALIGN 2-NOALIGN
  55.             ArrowTypeD1     @ D1SubRec + 70 ,\  -- ATYPE
  56.             TolTypeD1       @ D1SubRec + 72 ,\  -- TTYPE
  57.             TolPrecD1       @ D1SubRec + 74 ,\  -- TPREC
  58.             CPLusedD1       @ D1SubRec + 76 ,\  -- CPL
  59.             PrecD1          @ D1SubRec + 78 ,\  -- PREC
  60.             CenterD1        @ D1SubRec + 80     -- CENTER
  61.     
  62.     --end of D1SubRec definition-------------------------------
  63.     
  64.     const integer LDim = 6             --entity type  
  65.     const integer CR = 13, Comma = 44  --ascii values
  66.  
  67.     integer Type, NumEnts, IEnd, NBytesGot, i, ierr, DummyList(1), Mib
  68.     real MTol, PTol, Dim
  69.     string SrType:2, Nomdim:10
  70.     boolean FirstType
  71.     
  72.   --Allow only linear dimensions to be chosen
  73.     EntMask(0); EntMask(LDim)
  74.     
  75.   --Prompt for and return digitized dimensions
  76.     loop
  77.         print "Ldims to add: ",
  78.         GetEnt(-1, NumEnts, DummyList(1), IEnd)
  79.         
  80.         MTol = 0.0; PTol = 0.0; Dim = 0.0
  81.         FirstType = true
  82.         
  83.       --Go through list of entites, retrieve dimension info from
  84.       --database using the subrecord template and database access
  85.       --intrinsics.
  86.         loop i = 1 to NumEnts
  87.             Mib = BigMibList(i)
  88.             SrType = "D1"
  89.             GetSrI(Mib, SrType, 1, 84, NBytesGot, D1SubRec(1), ierr)
  90.             if ierr = 0 then
  91.                 if FirstType then
  92.                     Type = TypeD1
  93.                     FirstType = false
  94.                 endif
  95.  
  96.               --Check for correct type of dimension and then calculate
  97.               --the nominal dimensions and tolerances.
  98.                 if Type = TypeD1 then
  99.                     PTol = PTol+Tol1D1
  100.                     MTol = MTol+Tol2D1
  101.  
  102.                   --This direct database access procedure is written
  103.                   --especailly for TX subrecords: no template is 
  104.                   --necessary
  105.                     RSubrecTX(Mib,1,ierr,Nomdim)
  106.                     if TolTypeD1 = 1 then
  107.                         Dim = Dim+(Real(Nomdim)-Tol1D1)
  108.                     else
  109.                         Dim = Dim+Real(Nomdim)
  110.                     endif
  111.                     RpntEnt(Mib, 1, ierr)
  112.                 else
  113.                     print "<Entity types mismatched>  ",
  114.                 endif
  115.             endif
  116.         end loop 
  117.         exit when LastChar = CR or LastChar = Comma or NumEnts = 0
  118.     end loop
  119.  
  120.   --If a comma was entered, calculate the differences of following
  121.   --digitizes, otherwise, skip to end and print results. The process
  122.   --is the same as above...
  123.     if LastChar = Comma then 
  124.         loop
  125.             print "Ldims to subtract: ",
  126.             GetEnt(-1, NumEnts, DummyList(1), IEnd)
  127.         
  128.             loop i = 1 to NumEnts
  129.                 Mib = BigMibList(i)
  130.                 SrType = "D1"
  131.                 GetSrI(Mib, SrType, 1, 84, NBytesGot, D1SubRec(1), ierr)
  132.                 if ierr = 0 then
  133.                     if Type = TypeD1 then
  134.                         PTol = PTol-Tol1D1
  135.                         MTol = MTol-Tol2D1
  136.                         RSubrecTX(Mib,1,ierr,Nomdim)
  137.                         if TolTypeD1 = 1 then
  138.                             Dim = Dim-(Real(Nomdim)-Tol1D1)
  139.                         else
  140.                             Dim = Dim-Real(Nomdim)
  141.                         endif
  142.                         RpntEnt(Mib, 1, ierr)
  143.                     else
  144.                         print "<Entity types mismatched>  ",
  145.                     endif
  146.                 endif
  147.             end loop 
  148.  
  149.            exit when LastChar = CR or NumEnts = 0
  150.         end loop
  151.     endif --LastChar = Comma
  152.  
  153.   --Ouput results
  154.     if LastChar <> CR then print; endif
  155.     print "Total: ",Dim: PrecD1+1
  156.     print "MTOL: ",MTol," ,  PTOL: ",PTol
  157.     print "Limits: ",Dim-MTol: PrecD1+1,
  158.     print " to ",Dim+PTol: PrecD1+1
  159.  
  160. end proc
  161. 
  162.