home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p115 / 10.ddi / GCD4 / UPL / TUBE.UPL < prev    next >
Encoding:
Text File  |  1986-05-22  |  3.8 KB  |  125 lines
  1. PROC MAIN
  2.     
  3.     INTEGER IENT, ETYP, NVERT, I, MIL(500), NENT, IEND
  4.     COORD U, A1, A2, A3, A4, B1, B2, B3, B4, E1, E2
  5.     REAL R
  6.     
  7.     --make new entities red
  8.  
  9.     ECHO OFF
  10.     SEND ' SEL COLOR 1 '
  11.     ECHO ON
  12.     
  13.     LOOP
  14.  
  15.         --get tube radius
  16.  
  17.         LOOP
  18.             ACCEPT R PROMPT(' tube/duct radius ') LAST(' :#13#3')
  19.             EXIT WHEN R > 0.0 OR LAST_CHAR = 13 OR LAST_CHAR = 3
  20.             PRINT ' must be greater than 0',
  21.         END_LOOP
  22.  
  23.         --check for RETURN or ^C
  24.  
  25.         EXIT WHEN LAST_CHAR = 13 OR LAST_CHAR = 3
  26.  
  27.         --echo last character
  28.  
  29.         PRINT CHAR(LAST_CHAR),
  30.         
  31.         LOOP
  32.             PRINT ':pick lines ',
  33.  
  34.             --get list of entities
  35.  
  36.             GET_ENT(500, NENT, MIL(1), IEND)
  37.  
  38.             --exit if no entities picked of got a ^C
  39.  
  40.             EXIT WHEN NENT = 0 OR LAST_CHAR = 3
  41.  
  42.             ECHO OFF
  43.  
  44.             --loop through the selected entites
  45.  
  46.             LOOP IENT = 1 TO NENT
  47.                 VERIFY ENT_TYP(ETYP), ENT_ID(MIL(IENT)) 
  48.                 IF ETYP = 1 THEN
  49.                     VERIFY LINE ENT_ID(MIL(IENT)), ENDS(E1, E2)
  50.     
  51.                     U = VUNIT(E2-E1)       --get unit vector along E1 E2
  52.                     
  53.                     IF U.X <> 0.0 THEN
  54.                         
  55.                         --calculate a single point which is
  56.                         --perpendicular to U at R distance
  57.                         
  58.                         A1.Y = R/SQRT((U.Y/U.X)**2.0+1.0)
  59.                         A1.X = -(U.Y/U.X)*A1.Y
  60.                     ELSE
  61.                         
  62.                         --special case if X component of U is 0 
  63.                         
  64.                         A1.X = R
  65.                         A1.Y = 0.0
  66.                     ENDIF
  67.                     
  68.                     --we are picking a point on the circle where Z = 0
  69.  
  70.                     A1.Z = 0.0  
  71.                     
  72.                     --calculate 3 other points that are perpendicular
  73.                     --to each other on the circle
  74.                     
  75.                     A2 = VCROSS(U, A1)
  76.                     A3 = VCROSS(A1, U)
  77.                     A4 = VCROSS(A3, U)
  78.                     
  79.                     --translate B points back to E2
  80.                     
  81.                     B1 = A1+E2
  82.                     B2 = A2+E2
  83.                     B3 = A3+E2
  84.                     B4 = A4+E2 
  85.                     
  86.                     --translate A points back to E1
  87.                     
  88.                     A1 = A1+E1
  89.                     A2 = A2+E1
  90.                     A3 = A3+E1
  91.                     A4 = A4+E1 
  92.                     
  93.                     --insert 2 circles given 3 points
  94.                     
  95.                     SEND
  96.                     SEND 'INS CIR:MODEL X ',A1.X,' Y ',A1.Y,'Z ',A1.Z, \
  97.                                 ',MODEL X ',A2.X,' Y ',A2.Y,'Z ',A2.Z, \
  98.                                 ',MODEL X ',A3.X,' Y ',A3.Y,'Z ',A3.Z, \
  99.                                 ';MODEL X ',B1.X,' Y ',B1.Y,'Z ',B1.Z, \
  100.                                 ',MODEL X ',B2.X,' Y ',B2.Y,'Z ',B2.Z, \
  101.                                 ',MODEL X ',B3.X,' Y ',B3.Y,'Z ',B3.Z
  102.  
  103.                     --insert 4 lines around the tube
  104.  
  105.                     INSERT LINE ENDS(A1,B1) RPNT(TRUE)
  106.                     INSERT LINE ENDS(A2,B2) RPNT(TRUE)
  107.                     INSERT LINE ENDS(A3,B3) RPNT(TRUE)
  108.                     INSERT LINE ENDS(A4,B4) RPNT(TRUE)
  109.  
  110.                 ENDIF
  111.             END_LOOP
  112.  
  113.             ECHO ON
  114.     
  115.             EXIT WHEN LAST_CHAR = 13 OR LAST_CHAR = ASCII(':')
  116.         END_LOOP 
  117.         
  118.         --completely done if we get a RETURN or a ^C
  119.  
  120.         EXIT WHEN LAST_CHAR = 13 OR LAST_CHAR = 3
  121.     END_LOOP
  122.  
  123. END PROC
  124.  
  125.