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 / POSTRIM.CDL < prev    next >
Encoding:
Text File  |  1989-03-09  |  2.4 KB  |  111 lines
  1. REM     name:     postrim.cdl
  2.  
  3. REM     date:     030789 simon izraelevitz
  4.  
  5. REM     task:     trims/extends a line to a position
  6.  
  7. REM     -----------------------------------------------
  8.  
  9.    CLEAR
  10.    accuracy = 0.00005
  11.    ARRAY  vm[9]
  12.  
  13. :ind_ln
  14. REM     *** get line
  15.    SET mask,2
  16.    GETENT  "Indicate line to trim or extend.", etype
  17.    IF (@KEY <= -2)
  18.       GOTO exit
  19.  
  20.    p1wx = @FLTDAT[0]
  21.    p1wy = @FLTDAT[1]
  22.    p1wz = @FLTDAT[2]
  23.    p2wx = @FLTDAT[3]
  24.    p2wy = @FLTDAT[4]
  25.    p2wz = @FLTDAT[5]
  26.  
  27. REM     *** store present construction view
  28.    CALL memcpy,vm,0,@CVIEWMAT,0,9
  29.  
  30. REM     *** define line unit vector, in world coord.
  31.    dx = p2wx - p1wx
  32.    dy = p2wy - p1wy
  33.    dz = p2wz - p1wz
  34.    magn = sqrt(dx*dx + dy*dy + dz*dz)
  35.    IF (magn <= accuracy)
  36.       GOTO error2
  37.    uwx = dx/magn
  38.    uwy = dy/magn
  39.    uwz = dz/magn
  40.  
  41. REM     *** save cursor pick
  42.    crvx = @XCURSOR
  43.    crvy = @YCURSOR
  44.    crvz = @DEPTH
  45.  
  46. REM     *** map line to view coord.
  47.    CALL xfmwv,vm,p1wx,p1wy,p1wz,p1vx,p1vy,p1vz
  48.    CALL xfmwv,vm,p2wx,p2wy,p2wz,p2vx,p2vy,p2vz
  49.  
  50. REM     *** define line unit vector, x and y view coord only.
  51.    dx = p2vx - p1vx
  52.    dy = p2vy - p1vy
  53.    vmagn = sqrt(dx*dx + dy*dy)
  54.    uvx = dx/vmagn
  55.    uvy = dy/vmagn
  56.  
  57. REM     *** get position to trim/extend to
  58. :get_pos
  59.    defopt = 1
  60.    GETPOS "Indicate trim/extend position.",defopt
  61.    ON (@KEY + 3) GOTO exit,ind_ln,get_pos,
  62.    psvx = @XVIEW
  63.    psvy = @YVIEW
  64.    psvz = @DEPTH
  65.  
  66. REM     *** projection from cursor pick to line
  67.    val1 = (crvx - p1vx)*uvx + (crvy - p1vy)*uvy 
  68.  
  69. REM     *** projection from position to line
  70.    val2 = (psvx - p1vx)*uvx + (psvy - p1vy)*uvy 
  71.    IF (abs(val2 - val1) <= accuracy)
  72.       GOTO error2
  73.  
  74. REM     *** compute projection point on line
  75.    pjvx = p1vx + val2*uvx
  76.    pjvy = p1vy + val2*uvy
  77.    pjvz = (p2vz-p1vz)*val2/vmagn + p1vz
  78.  
  79. REM     *** map projection point to world and delete line
  80.    CALL xfmvw,vm,pjvx,pjvy,pjvz,pjwx,pjwy,pjwz
  81.    DELENT
  82.  
  83. REM     *** define direction flag
  84.    dir = (val2 - val1)/abs(val2 - val1)
  85.    IF (dir > 0)
  86.       GOTO flag1
  87.    IF (dir < 0)
  88.       GOTO flag2
  89.  
  90. :flag1  
  91.    LINE  p1wx,p1wy,p1wz,pjwx,pjwy,pjwz
  92.    GOTO ind_ln
  93.  
  94. :flag2  
  95.    LINE  pjwx,pjwy,pjwz,p2wx,p2wy,p2wz
  96.    GOTO ind_ln
  97.  
  98. :error1
  99.    PROMPT  " Ambiguos direction... Indicate position again "
  100.    WAIT 2
  101.    GOTO ind_ln
  102.  
  103. :error2
  104.    PROMPT  " Zero length line... Select again."
  105.    WAIT 2
  106.    GOTO ind_ln
  107.  
  108. :exit
  109.    SET mask
  110.    EXIT
  111.