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 / PTVECTOR.CDL < prev    next >
Encoding:
Text File  |  1989-03-09  |  2.2 KB  |  92 lines
  1. REM     name:     ptvector.cdl
  2.  
  3. REM     date:     091187 simon izraelevitz
  4.  
  5. REM     task:     creates a point along a vector at a given distance 
  6. REM               from a base point
  7.  
  8. REM     -----------------------------------------------
  9.  
  10.    CLEAR
  11.    dist = 1
  12.    posopt = 2
  13.  
  14. :ind_ln
  15. REM     *** get vector line
  16.    SET mask,2
  17.    GETENT  "Indicate vector line.", etype
  18.    ON (@KEY + 3) GOTO exit,exit,
  19.    p1wx = @FLTDAT[0]
  20.    p1wy = @FLTDAT[1]
  21.    p1wz = @FLTDAT[2]
  22.    p2wx = @FLTDAT[3]
  23.    p2wy = @FLTDAT[4]
  24.    p2wz = @FLTDAT[5]
  25.    
  26. REM     *** compute unit vector in world coord.
  27.    dx = p2wx - p1wx
  28.    dy = p2wy - p1wy
  29.    dz = p2wz - p1wz
  30.    magn = sqrt(dx*dx + dy*dy + dz*dz)
  31.    uwx = dx/magn
  32.    uwy = dy/magn
  33.    uwz = dz/magn
  34.    
  35. REM     *** map line to view coord.
  36.    CALL xfwv,p1wx,p1wy,p1wz,p1vx,p1vy,p1vz
  37.    CALL xfwv,p2wx,p2wy,p2wz,p2vx,p2vy,p2vz
  38.  
  39. REM     *** define line unit vector, view coord.
  40.    dx = p2vx - p1vx
  41.    dy = p2vy - p1vy
  42.    dz = p2vz - p1vz
  43.    magn = sqrt(dx*dx + dy*dy + dz*dz)
  44.    uvx = dx/magn
  45.    uvy = dy/magn
  46.    uvz = dz/magn
  47.  
  48. REM     *** save cursor pick coordinates
  49.    cr1x = @XCURSOR
  50.    cr1y = @YCURSOR
  51.  
  52. :get_dir
  53. REM     *** get vector direction
  54.    defopt  =1
  55.    GETPOS  "Indicate direction",defopt
  56.    ON (@KEY + 3) GOTO exit,ind_ln,get_dir,
  57.    cr2x = @XCURSOR
  58.    cr2y = @YCURSOR
  59.  
  60. REM     *** calculate projected distances from cursor picks
  61. REM         to first end point of line
  62.    dist1 = (cr1x - p1vx)*uvx + (cr1y - p1vy)*uvy
  63.    dist2 = (cr2x - p1vx)*uvx + (cr2y - p1vy)*uvy
  64.  
  65. REM     *** define vector direction flag
  66.    dir = (dist2 - dist1)/abs(dist2 - dist1)
  67.  
  68. :get_pt
  69. REM     *** get base point
  70.    GETPOS  "Indicate base point",posopt
  71.    posopt = @KEY
  72.    ON (@KEY + 3) GOTO exit,ind_ln,get_pt,
  73.    pwx = @XWORLD
  74.    pwy = @YWORLD
  75.    pwz = @ZWORLD
  76.  
  77. :get_dist
  78. REM     *** get distance from base point
  79.    GETFLT  "Enter delta distance from base point (%f) =",dist,dist
  80.    ON (@KEY + 3) GOTO exit,get_pt,
  81.  
  82. REM *** point vector definition
  83.    npx = pwx + dir*dist*uwx
  84.    npy = pwy + dir*dist*uwy
  85.    npz = pwz + dir*dist*uwz
  86.    POINT  npx,npy,npz
  87.    GOTO get_pt
  88.  
  89. :exit
  90.    SET mask
  91.    EXIT
  92.