home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p115 / 10.ddi / GCD4 / UPL / DUALDIMS.UPL < prev    next >
Encoding:
Text File  |  1988-03-17  |  4.9 KB  |  116 lines
  1. --  11-Mar-88 NEHolt; Created - UPL 3.0 demo program
  2. --
  3. --  ------------------------------------ DUALDIMS.UPL -------------
  4. --  PURPOSE: Provide "dual" English/Metric dimensioning. Digitize
  5. --  "English" dimension text, program calculates metric equivalent
  6. --  and then inserts the metric dimension in parenthesis right below
  7. --  the existing English value.
  8. --
  9. --  This program:    I N C H E S   o r   F T / I N   t o   M E T E R S
  10.  
  11.  PROC MAIN
  12.  
  13.     INTEGER Ngot,Iend,j,k,i,ierr,EntMib(1),ix,ipower,ModSet
  14.     BOOLEAN ModYes
  15.     STRING Txt_Str:42,JunkStr:42,subString:42
  16.     REAL Rval,X,Nearest
  17.  
  18. -- * * *   start of executable code   * * *
  19.     BREAK_CHAR = 3   -- set up CTRL-C to abort (ascii 03 = ^C)
  20.     -- Set up a single modifier table. Modifier will be NEAREST.
  21.     DefineModifier(1,'Nearest','R',True,0.01) -- default will be 0.01
  22.     print '(modifier) ',
  23.     AskModifiers(0)  -- 0 = use UPL defined modifiers
  24.     GetModifier(1,ModYes,Nearest,JunkStr) -- retrieve NEAREST value
  25.                                           -- if entered by user.
  26.     EntMask(6)  -- only allow an LDIM entity or
  27.     EntMask(4)  -- a TEXT entity to be digitized
  28.  
  29. NextDim:
  30.     Print ': ent LDIM ',    -- prompt user to digitize the LDIM text
  31.     GetEnt(1,Ngot,EntMib(1),Iend)        -- get mib of digitized ent
  32.     if Ngot <> 1 then goto DONE;endif      -- quit if none digitized
  33.     Print
  34.     -- Get dimension text string. This text string could be a decimal
  35.     -- number, a number with a ' or " mark, or a value with a dash.
  36.     RSubrecTX(EntMib(1),1,ierr,Txt_Str)  -- Text string in "TX" subrec
  37.     --  C O N V E R T    D I M   T E X T   T O   R E A L   N U M
  38.     -- Possible forms: xxx.xx,  x'-y",  x'-y a/b"
  39.     RVal=0.0
  40.     -- First try looking for a decimal point.
  41.     ix=Index(Txt_Str,1,'.')
  42.     If ix<>0 then                 --  D E C I M A L   V A L U E
  43.       Rval=Real(Txt_Str)
  44.     else
  45.       -- Try looking for a ' mark for FEET.
  46.       JunkStr=Txt_Str
  47.       ix=Index(Txt_Str,1,"'")
  48.       if ix<>0 then                --  F E E T   V A L U E
  49.         Rval=12.0*Real(Extract(Txt_Str,1,ix-1))
  50.         JunkStr=Extract(Txt_Str,ix+1,99)  -- Strip off FEET
  51.         if Extract(JunkStr,1,1)='-' then
  52.           JunkStr=Extract(JunkStr,2,99)  -- Strip off "dash"
  53.         endif
  54.       endif
  55.       -- Try looking for an " mark for INCHES
  56.       ix=Index(JunkStr,1,'"')
  57.       If ix<>0 then                --  I N C H   V A L U E
  58.         JunkStr=Extract(JunkStr,1,ix-1) -- Strip off " sign
  59.         Rval=Rval+Real(JunkStr)
  60.       endif
  61.     endif
  62.     -- convert to metric (inches to meters)
  63.     Rval=Rval*0.0254
  64.  
  65.     --  R O U N D   C O N V E R T E D   M E T R I C   V A L U E
  66. Here1:
  67.     -- Round the converted metric value (in Rval) to the nearest value
  68.     -- in NEAREST. Ex: if Nearest =0.025 then round RVal to the nearest
  69.     -- 0.025 meter. To do this, figure out how many times NEAREST goes
  70.     -- into RVal. Round to nearest whole number.  Then multiply by the
  71.     -- NEAREST value to end up with the rounded metric dimension value.
  72.     x=Rval/Nearest; JunkStr=STRING(x)
  73.     i=INDEX(JunkStr,1,'E')  -- look for an 'E' in the converted string
  74.  
  75.     -- if engineering notation then convert to straight decimal num.
  76.     if i>0 then
  77.       ipower=Integer(Extract(JunkStr,i+2,99))
  78.       j=Index(JunkStr,1,'.')          -- locate existing decimal point
  79.       -- get characters between decimal point and 'E'
  80.       subString=Extract(JunkStr,j+1,i-j-1)
  81.       if i-j-1<ipower then            -- pad extra zeroes if necessary
  82.         loop k=1 to ipower-i+j+1
  83.           subString=subString+'0'
  84.         end_loop
  85.       endif
  86.       -- lop off extra characters if necessary
  87.       if i-j-1>ipower then subString=EXTRACT(subString,1,ipower);endif
  88.       -- Assemble entire number and add trailing decimal point
  89.       JunkStr=Extract(JunkStr,1,j-1)+subString+'.'
  90.     endif
  91.  
  92.     x=Real(Extract(JunkStr,1,(Index(JunkStr,1,'.')-1)))
  93.     x=Nearest*x
  94.     if (Rval-x)>=Nearest/2.0 then x=x+Nearest;Endif
  95.     Rval=x
  96.     JunkStr=String(Rval) -- convert metric dimension to text string
  97.     --  C L E A N   U P   T H E   C O N V E R T E D   T E X T
  98.     -- Determine the correct number of decimal places
  99.     i=Index(JunkStr,1,'.')
  100.     j=JunkStr.LENGTH
  101.     if i<j then JunkStr=Extract(JunkStr,1,j-1);endif
  102.     -- get rid of decimal point if string now ends in decimal point
  103.     if i=JunkStr.LENGTH then JunkStr=Extract(JunkStr,1,i-1);endif
  104.     -- add leading zero if first character is decimal point
  105.     if i=1 then JunkStr='0'+JunkStr;Endif
  106.     JunkStr=RmvChr(JunkStr,' ') -- remove any blank spaces
  107.     Txt_Str=Txt_Str+'#13'+'('+JunkStr+' M)' -- append to end of English
  108.  
  109.     -- Write new dimension "TX" subrecord back to the database
  110.     MSubrecTX(EntMib(1),1,ierr,Txt_Str)
  111.     RpntEnt(EntMib(1),1,ierr)     -- repaint the dimension text
  112.     goto NextDim           -- loop back up to allow another digitize
  113. DONE:
  114.  END PROC
  115.  
  116.