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 / CYLINT.CDL < prev    next >
Encoding:
Text File  |  1989-03-06  |  4.5 KB  |  198 lines
  1. rem     name:     cylint.cdl
  2.  
  3. rem     date:     111787 simon izraelevitz
  4.  
  5. rem     task:     creates a spline intersection of two cylinders.
  6.  
  7. rem     error checking: impossible input conditions are 
  8. rem                     checked and appropiate messages prompted. 
  9.  
  10. rem     -----------------------------------------------
  11.  
  12. clear
  13. array  vm1[9]
  14. array  vm2[9]
  15. array  vm3[9]
  16. array  int1[75][3]
  17. array  int2[75][3]
  18.  
  19. :start
  20. set mask,3
  21. errflag =0
  22.  
  23. rem     *** get present view ***
  24. getview @view
  25.  
  26. i       =-1
  27.  
  28. :vmloop3
  29.         i=i + 1
  30. vm3[i]  =@fltdat[i]
  31.         if (i <  8)
  32.         goto vmloop3
  33.  
  34. rem     *** get first cylinder data ***
  35. :cir1cyl1
  36. getent  "Indicate first circular end of first cylinder", etype
  37.         if (@key <= -2)
  38.            goto done
  39.            goto rdc1cyl1
  40.  
  41. :rdc1cyl1
  42. cy1x1   =@fltdat[0]
  43. cy1y1   =@fltdat[1]
  44. cy1z1   =@fltdat[2]
  45. cy1rad  =@fltdat[3]
  46.  
  47. getview @intdat[8]
  48.  
  49. i       =-1
  50.  
  51. :vmloop1
  52.         i=i + 1
  53. vm1[i]  =@fltdat[i]
  54.         if (i <  8)
  55.         goto vmloop1
  56.  
  57. :cir2cyl1
  58. getent  "Indicate second circular end of first cylinder", etype
  59.         on (@key + 3) goto done,start,cir2cyl1,rdc2cyl1,
  60.  
  61. :rdc2cyl1
  62. cy1x2   =@fltdat[0]
  63. cy1y2   =@fltdat[1]
  64. cy1z2   =@fltdat[2]
  65.  
  66. rem     *** get second cylinder data ***
  67. :cir1cyl2
  68. getent  "Indicate first circular end of second cylinder", etype
  69.         on (@key + 3) goto done,cir2cyl1,cir1cyl2,rdc1cyl2,
  70.  
  71. :rdc1cyl2
  72. cy2x1   =@fltdat[0]
  73. cy2y1   =@fltdat[1]
  74. cy2z1   =@fltdat[2]
  75. cy2rad  =@fltdat[3]
  76.  
  77. getview @intdat[8]
  78.  
  79. i       =-1
  80.  
  81. :vmloop2
  82.         i=i + 1
  83. vm2[i]  =@fltdat[i]
  84.         if (i <  8)
  85.         goto vmloop2
  86.  
  87. :cir2cyl2
  88. getent  "Indicate second circular end of second cylinder", etype
  89.         on (@key + 3) goto done,cir1cyl1,cir2cyl2,rdc2cyl2,
  90.  
  91. :rdc2cyl2
  92. cy2x2   =@fltdat[0]
  93. cy2y2   =@fltdat[1]
  94. cy2z2   =@fltdat[2]
  95.  
  96. rem     *** print present view data ***
  97.         set devout,.\cdlout.dat,0
  98.         print "%.8f,%.8f,%.8f,%.8f,%.8f,%.8f,%.8f,%.8f,%.8f,\n",\
  99.                vm3[0],vm3[1],vm3[2],vm3[3],vm3[4],vm3[5],vm3[6],vm3[7],vm3[8]
  100.  
  101. rem     *** print first cylinder data data ***
  102.         set devout,.\cdlout.dat,1
  103.         print "%.8f,%.8f,%.8f,%.8f,%.8f,%.8f,%.8f,\n",\
  104.                cy1x1,cy1y1,cy1z1,cy1x2,cy1y2,cy1z2,cy1rad
  105.  
  106. rem     *** print first cylinder view data ***
  107.         print "%.8f,%.8f,%.8f,%.8f,%.8f,%.8f,%.8f,%.8f,%.8f,\n",\
  108.                vm1[0],vm1[1],vm1[2],vm1[3],vm1[4],vm1[5],vm1[6],vm1[7],vm1[8]
  109.  
  110. rem     *** print second cylinder data data ***
  111.         print "%.8f,%.8f,%.8f,%.8f,%.8f,%.8f,%.8f,\n",\
  112.                cy2x1,cy2y1,cy2z1,cy2x2,cy2y2,cy2z2,cy2rad
  113.  
  114. rem     *** print second cylinder view data ***
  115.         print "%.8f,%.8f,%.8f,%.8f,%.8f,%.8f,%.8f,%.8f,%.8f,\n",\
  116.                vm2[0],vm2[1],vm2[2],vm2[3],vm2[4],vm2[5],vm2[6],vm2[7],vm2[8]
  117.  
  118. rem     *** execute "entfil.com" ***
  119. :execute
  120.         set devout, NULL
  121.         exec 2,"cylint"
  122.  
  123. rem     *** read intersection flag ***
  124.         read .\pascout.dat,0,intflag
  125.  
  126.         on (intflag) goto none,intrsect,
  127.  
  128. rem     *** read number of intersection points ***
  129. :intrsect
  130.         read .\pascout.dat,1,numpts
  131.  
  132.         on (intflag - 1) goto total,partial,
  133.  
  134. :total
  135. rem     *** read first intersection points and create int spline ***
  136. i       =-1
  137. :pts1
  138.         i=i + 1
  139.         j=-1
  140. :coord1
  141.         j=j + 1        
  142.         read .\pascout.dat,1,int1[i][j]
  143.         if (j < 2)
  144.            goto coord1
  145.         if (i < (numpts - 1))
  146.            goto pts1
  147.  
  148.         spline P3NN,int1,numpts,
  149.  
  150. rem     *** read second intersection points and create int spline ***
  151. i       =-1
  152. :pts2
  153.         i=i + 1
  154.         j=-1
  155. :coord2
  156.         j=j + 1        
  157.         read .\pascout.dat,1,int2[i][j]
  158.         if (j < 2)
  159.            goto coord2
  160.         if (i < (numpts - 1))
  161.            goto pts2
  162.  
  163.         spline P3NN,int2,numpts,
  164.         goto start
  165.  
  166. :partial
  167. i       =-1
  168.  
  169. rem     *** read intersection points ***
  170. :pts3
  171.         i=i + 1
  172.         j=-1
  173. :coord3
  174.         j=j + 1        
  175.         read .\pascout.dat,1,int1[i][j]
  176.         if (j < 2)
  177.            goto coord3
  178.         if (i < (2 * numpts - 3))
  179.            goto pts3
  180. int1[2 * numpts -2][0] = int1[0][0]
  181. int1[2 * numpts -2][1] = int1[0][1]
  182. int1[2 * numpts -2][2] = int1[0][2]
  183.  
  184.         spline P3NN,int1,(2 * numpts - 1),
  185.         goto start
  186.  
  187. rem     *** error messages ***
  188.  
  189. :none
  190. prompt  " cylinders do not intersect, select again"
  191.          wait 2.0
  192.         goto start
  193.  
  194. rem     *** exit to CADKEY ***
  195. :done  
  196. set mask
  197. exit
  198.