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 / PTSURF.CDL < prev    next >
Encoding:
Text File  |  1989-03-06  |  2.0 KB  |  83 lines
  1. REM     name:     ptsurf.cdl
  2.  
  3. REM     date:     030289 simon izraelevitz
  4.  
  5. REM     task:     projects points onto a polygonal surface
  6.  
  7. REM     -----------------------------------------------
  8.  
  9.    CLEAR
  10.    plevel = @LEVEL
  11.  
  12. :get_level
  13.    GETINT  "Enter level number to store new points (%d) = ",plevel,newlevel
  14.    ON (@KEY + 3) GOTO exit,exit,
  15.    LEVELS 1,newlevel
  16.         
  17. REM   *** get point to project
  18. :ind_pt
  19.    def = 2
  20.    GETPOS "Indicate point to project...", def
  21.    ON (@KEY + 3) GOTO exit,get_level,ind_pt,
  22.    pwx = @XWORLD
  23.    pwy = @YWORLD
  24.    pwz = @ZWORLD
  25.  
  26. REM   *** map to present view
  27.    CALL xfwv,pwx,pwy,pwz,pvx,pvy,pvz
  28.  
  29. REM   *** get polygon to intersect
  30. :ind_poly
  31.    SET mask,6
  32.    GETENT  "Indicate polygon to project to ...", etype
  33.    ON (@KEY + 3) GOTO exit,indln,indarc,
  34.    IF (@INTDAT[10] > 3)
  35.       GOTO error
  36.    p1wx = @FLTDAT[0]
  37.    p1wy = @FLTDAT[1]
  38.    p1wz = @FLTDAT[2]
  39.    p2wx = @FLTDAT[3]
  40.    p2wy = @FLTDAT[4]
  41.    p2wz = @FLTDAT[5]
  42.    p3wx = @FLTDAT[6]
  43.    p3wy = @FLTDAT[7]
  44.    p3wz = @FLTDAT[8]
  45.  
  46. REM     ***  map vertices to present view 
  47.    CALL xfwv,p1wx,p1wy,p1wz,p1vx,p1vy,p1vz
  48.    CALL xfwv,p2wx,p2wy,p2wz,p2vx,p2vy,p2vz
  49.    CALL xfwv,p3wx,p3wy,p3wz,p3vx,p3vy,p3vz
  50.  
  51. REM   *** compute vector normal to polygon
  52.    v1x = p2vx - p1vx
  53.    v1y = p2vy - p1vy
  54.    v1z = p2vz - p1vz
  55.    v2x = p3vx - p1vx
  56.    v2y = p3vy - p1vy
  57.    v2z = p3vz - p1vz
  58.    CALL cross, v3x,v3y,v3z,v1x,v1y,v1z,v2x,v2y,v2z
  59.  
  60. REM   ***   compute polygon plane coefficients
  61.    magn = sqrt(v3x*v3x + v3y*v3y + v3z*v3z)
  62.    a    = v3x/magn
  63.    b    = v3y/magn
  64.    c    = v3z/magn
  65.    d    = -(a*p1vx + b*p1vy + c*p1vz)
  66.  
  67. REM   ***   project arc point onto plane
  68.    pvz  = -(a*pvx + b*pvy + d)/c
  69.  
  70. REM   ***   map projection point to world
  71.    CALL xfvw,pvx,pvy,pvz,pwx,pwy,pwz
  72.    POINT pwx,pwy,pwz,0,newlevel
  73.    GOTO ind_pt
  74.  
  75. :error
  76.         PROMPT "Polygon has more than three vertices..."
  77.         WAIT 2
  78.         GOTO ind_pt
  79.  
  80. :exit
  81.    SET mask
  82.    EXIT
  83.