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 / LNPTANG.CDL < prev    next >
Encoding:
Text File  |  1989-03-14  |  2.8 KB  |  129 lines
  1. REM     name:       lnptang.cdl
  2.  
  3. REM     date:       092987 simon izraelevitz
  4.  
  5. REM     task:       creates a line thru a position at a given angle
  6. REM                 from a base line or the x axis
  7.  
  8. REM     -----------------------------------------------
  9.  
  10.    CLEAR
  11.    ARRAY  vm[9]
  12.    PI = 3.1415926536
  13.    radang = 180/PI
  14.    accuracy = .00005
  15.    posdef = 2
  16.    ang = 30
  17.  
  18. :ind_ln
  19. REM     *** get base line
  20.    noline = 0
  21.    length = 5
  22.    SET mask,2
  23.    GETENT  "Indicate line. Return defaults to the x axis", etype
  24.  
  25. REM     *** get present construction view
  26.    CALL memcpy,vm,0,@CVIEWMAT,0,9
  27.  
  28.    ON (@KEY + 3) GOTO exit,exit,def_alpha,
  29.    p1wx = @FLTDAT[0]
  30.    p1wy = @FLTDAT[1]
  31.    p1wz = @FLTDAT[2]
  32.    p2wx = @FLTDAT[3]
  33.    p2wy = @FLTDAT[4]
  34.    p2wz = @FLTDAT[5]
  35.    dx = p2wx - p1wx
  36.    dy = p2wy - p1wy
  37.    dz = p2wz - p1wz
  38.    length = sqrt(dx*dx + dy*dy + dz*dz)
  39.    
  40. REM     *** map line to view coord.
  41.    CALL xfmwv,vm,p1wx,p1wy,p1wz,p1vx,p1vy,p1vz
  42.    CALL xfmwv,vm,p2wx,p2wy,p2wz,p2vx,p2vy,p2vz
  43.  
  44. REM     *** define line slope and coeffs.
  45.    dx = p2vx - p1vx
  46.    dy = p2vy - p1vy
  47.    CALL atan3,dy,dx,alpha
  48.    alpha = alpha*radang
  49.    IF (alpha >= 180)
  50.       alpha = alpha - 180
  51.    a1 = dy
  52.    b1 = -dx
  53.    c1 = -(p1vy*b1 + p1vx*a1)
  54.    GOTO ind_pt
  55.  
  56. :def_alpha
  57.    alpha = 0
  58.    noline = 1
  59.  
  60. :ind_pt
  61. REM     *** get position
  62.    GETPOS  "Indicate base position",posdef
  63.         ON (@KEY + 3) GOTO exit,ind_ln,ind_pt,
  64.    posdef = @KEY
  65.  
  66.    p1wx = @XWORLD
  67.    p1wy = @YWORLD
  68.    p1wz = @ZWORLD
  69.  
  70. REM   *** map position to view
  71.    CALL xfmwv,vm,p1wx,p1wy,p1wz,p1vx,p1vy,p1vz
  72.  
  73. :get_ang
  74. REM     *** get angle from base line
  75.    GETFLT  "Enter angle from base line (%f) = ",ang,ang
  76.         ON (@KEY + 3) GOTO exit,ind_pt,
  77.    IF noline
  78.       GOTO from_pt
  79.  
  80. REM     *** solution line coeffs
  81.    p2vx = p1vx + cos(alpha + ang)
  82.    p2vy = p1vy + sin(alpha + ang)
  83.    a2 = p2vy - p1vy
  84.    b2 = -(p2vx - p1vx)
  85.    c2 = -(p1vy*b2 + p1vx*a2)
  86.  
  87. REM     *** compute intersection point.
  88.  
  89.    det = a1*b2 - a2*b1
  90.    IF (abs(det) <= accuracy)
  91.       GOTO end_pt
  92.    dinv = 1/det
  93.    ipvx = (b1*c2 - b2*c1)*dinv
  94.    ipvy = (a2*c1 - a1*c2)*dinv
  95.    ipvz = p1vz
  96.  
  97. :end_pt
  98.    dx = p1vx - ipvx
  99.    dy = p1vy - ipvy
  100.    magn = sqrt(dx*dx + dy*dy)
  101.    IF (abs(magn) <= accuracy)
  102.       GOTO from_pt
  103.    dx = dx/magn
  104.    dy = dy/magn
  105.    p2vx = ipvx + dx*length
  106.    p2vy = ipvy + dy*length
  107.    p2vz = p1vz
  108.    GOTO map_sol
  109.  
  110. :from_pt
  111.    ipvx = p1vx
  112.    ipvy = p1vy
  113.    ipvz = p1vz
  114.    p2vx = ipvx + cos(alpha + ang)*length
  115.    p2vy = ipvy + sin(alpha + ang)*length
  116.    p2vz = ipvz
  117.  
  118. :map_sol
  119. REM     *** map solution line to world coord.
  120.    CALL xfmvw,vm,ipvx,ipvy,ipvz,ipwx,ipwy,ipwz
  121.    CALL xfmvw,vm,p2vx,p2vy,p2vz,p2wx,p2wy,p2wz
  122.  
  123.    LINE  ipwx,ipwy,ipwz,p2wx,p2wy,p2wz
  124.    GOTO ind_ln
  125.  
  126. :exit
  127. SET mask
  128. EXIT
  129.