home *** CD-ROM | disk | FTP | other *** search
/ Piper's Pit BBS/FTP: ibm 0010 - 0019 / ibm0010-0019 / ibm0010.tar / ibm0010 / CADKEY_C.ZIP / CADKEY14.ZIP / CDL / CIRLNEND.CDL < prev    next >
Encoding:
Text File  |  1989-03-10  |  1.9 KB  |  87 lines
  1. REM     name:     cirlnend.cdl
  2.  
  3. REM     date:     020589 simon i
  4.  
  5. REM     task:     creates circles at the end of a line for cylinder
  6. REM               representation
  7.  
  8. REM     -----------------------------------------------
  9.  
  10.    CLEAR
  11.    ARRAY  vm[9]
  12.    minval = .00005
  13.    rad = 1.0
  14.  
  15. :indln
  16. REM     *** get axis line
  17.    SET mask,2
  18.    GETENT  "Indicate axis line", etype
  19.    IF (@KEY <= -2)
  20.       GOTO exit
  21.  
  22.    p1wx = @FLTDAT[0]
  23.    p1wy = @FLTDAT[1]
  24.    p1wz = @FLTDAT[2]
  25.    p2wx = @FLTDAT[3]
  26.    p2wy = @FLTDAT[4]
  27.    p2wz = @FLTDAT[5]
  28.  
  29. REM     *** define view along axis line
  30.    dx = p2wx - p1wx
  31.    dy = p2wy - p1wy
  32.    dz = p2wz - p1wz
  33.    magn = sqrt(dx*dx + dy*dy + dz*dz)
  34.    IF (magn < minval)
  35.      GOTO message1
  36.    vm[2]   = dx/magn
  37.    vm[5]   = dy/magn
  38.    vm[8]   = dz/magn
  39.  
  40.    CALL dotprod, vm[2],vm[5],vm[8],1,0,0,dotx
  41.    CALL dotprod, vm[2],vm[5],vm[8],0,1,0,doty
  42.    IF (abs(dotx) <= abs(doty))
  43.      GOTO crossx
  44.    GOTO crossy
  45.  
  46. :crossx
  47.    CALL cross, dx,dy,dz,vm[2],vm[5],vm[8],1,0,0
  48.    magn  = sqrt(dx*dx + dy*dy + dz*dz)
  49.    vm[0] = dx/magn
  50.    vm[3] = dy/magn
  51.    vm[6] = dz/magn
  52.    GOTO y_axis 
  53.  
  54. :crossy
  55.    CALL cross, dx,dy,dz,vm[2],vm[5],vm[8],0,1,0
  56.    magn  = sqrt(dx*dx + dy*dy + dz*dz)
  57.    vm[0] = dx/magn
  58.    vm[3] = dy/magn
  59.    vm[6] = dz/magn
  60.  
  61. :y_axis
  62.    CALL cross, vm[1],vm[4],vm[7],vm[2],vm[5],vm[8],vm[0],vm[3],vm[6]
  63.    VIEW    1,vm[0],vm[1],vm[2],vm[3],vm[4],vm[5],vm[6],vm[7],vm[8]
  64.  
  65. :getrad
  66. REM     *** get cylinder radius
  67.    GETFLT  "Enter cylinder radius (%f) =",rad,rad
  68.    ON (@KEY + 3) GOTO exit,indln,
  69.  
  70. :done
  71. REM     * map end points to view
  72.    CALL xfmwv,vm,p1wx,p1wy,p1wz,p1vx,p1vy,p1vz
  73.    CALL xfmwv,vm,p2wx,p2wy,p2wz,p2vx,p2vy,p2vz
  74.  
  75.    CIRCLE  p1vx,p1vy,p1vz,rad,1
  76.    CIRCLE  p2vx,p2vy,p2vz,rad,1
  77.    GOTO indln
  78.  
  79. :error
  80.         prompt " Points are coincidental. Please, select again"
  81.         wait 2
  82.         GOTO indln
  83.  
  84. :exit
  85.    SET mask
  86.    EXIT
  87.