home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p115 / 10.ddi / GCD4 / UPL / LCIR.UPL < prev    next >
Encoding:
Text File  |  1986-05-22  |  2.6 KB  |  107 lines
  1. ---------------------------------------------------------------------------
  2. --This simple UPL program provides an easy way to insert circles which are
  3. --normal to a given line, at a given radius and have their origin at the 
  4. --ends of the line
  5. --
  6. --Norman Case  05-22-86
  7. ---------------------------------------------------------------------------
  8.  
  9. PROC LINE_CIRCLE(IN COORD C1, C2; REAL R)
  10.     
  11.     --This is a simple PROCedure to inserts a circle of radius R and origin at
  12.     --C1, which is normal to the vector C1 to C2
  13.  
  14.     COORD C3, CE1, CE2, CE3
  15.     
  16.     C3 = VUNIT(C2-C1)       --get unit vector along C1 C2
  17.  
  18.     IF C3.X <> 0.0 THEN
  19.  
  20.         --calculate a single point which is perpendicular to C3 at R distance
  21.  
  22.         CE1.Y = R/SQRT((C3.Y/C3.X)**2.0+1.0)
  23.         CE1.X = -(C3.Y/C3.X)*CE1.Y
  24.     ELSE
  25.  
  26.         --special case if X component of C3 is 0 
  27.  
  28.         CE1.X = R
  29.         CE1.Y = 0.0
  30.     ENDIF
  31.     
  32.     CE1.Z = 0.0     --we are picking a point on the circle where Z = 0
  33.  
  34.     --calculate 2 other points that are on the circle
  35.  
  36.     CE2 = VCROSS(C3, CE1)
  37.     CE3 = VCROSS(CE1, C3)
  38.     
  39.     --translate points back to C1
  40.  
  41.     CE1 = CE1+C1
  42.     CE2 = CE2+C1
  43.     CE3 = CE3+C1
  44.     
  45.     --insert circle given 3 points
  46.  
  47.     ECHO OFF
  48.     SEND 'INS CIR:MODEL X ',CE1.X,' Y ',CE1.Y,'Z ',CE1.Z, \
  49.                 ',MODEL X ',CE2.X,' Y ',CE2.Y,'Z ',CE2.Z, \
  50.                 ',MODEL X ',CE3.X,' Y ',CE3.Y,'Z ',CE3.Z
  51.     ECHO ON
  52.     
  53. END PROC
  54.  
  55. --------------------------------------------------------------------
  56.  
  57. PROC MAIN
  58.  
  59.     CONST INTEGER MAX_ENT = 1
  60.     INTEGER IENT, ETYP, MIL(MAX_ENT), NENT, IEND
  61.     COORD C1, C2
  62.     REAL R
  63.     
  64.     SEND ' ',
  65.  
  66.     --get radius
  67.  
  68.     ACCEPT R PROMPT(' radius ') LAST(' #13')
  69.  
  70.     LOOP
  71.  
  72.         --get lines to put circles on
  73.  
  74.         PRINT ' pick line ',
  75.         GET_ENT(MAX_ENT, NENT, MIL(1), IEND)
  76.  
  77.         EXIT WHEN NENT = 0 OR LAST_CHAR = 3
  78.  
  79.         --loop through all picked entities
  80.  
  81.         LOOP IENT = 1 TO NENT
  82.  
  83.             --check the entity type
  84.  
  85.             VERIFY ENT_TYP(ETYP), ENT_ID(MIL(IENT))
  86.             IF ETYP = 1 THEN
  87.  
  88.                 --we got a line, now get end points of line
  89.  
  90.                 VERIFY LINE ENT_ID(MIL(IENT)), ENDS(C1, C2)
  91.  
  92.                 IF IEND = 1 THEN
  93.                     LINE_CIRCLE(C1, C2, R)      --insert circle at end 1
  94.                 ELSE
  95.                     LINE_CIRCLE(C2, C1, R)      --insert circle at end 2
  96.                 ENDIF
  97.             ENDIF
  98.         END_LOOP
  99.  
  100.         --if last character input was a cariage return then we are all done
  101.  
  102.         EXIT WHEN LAST_CHAR = 13
  103.     END_LOOP 
  104.     
  105. END PROC
  106.  
  107.