home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p068 / 4.img / CYLINDER.CDL < prev    next >
Encoding:
Text File  |  1989-01-04  |  5.9 KB  |  266 lines
  1. REM  @(#)CADKEY SOLIDS    cylinder.cdl    2.2    10/31/88
  2. REM program to draw right circular cylinder entity
  3. array vmat[9]
  4.  
  5. :length
  6. REM Positive length of the cylinder
  7.  
  8. getflt "Length of the cylinder (%f) =>", 1.00, len
  9. if (@key <= -2)
  10.         exit
  11. if (len > 0.00001)
  12.         goto radius
  13. pause "Invalid length ... (Press RETURN)"
  14. goto length
  15.  
  16. :radius
  17. REM Positive radius for the cylinder
  18.  
  19. getflt "Radius of the cylinder (%f) =>", 0.5, rad
  20. if (@key == -3)
  21.         exit
  22. if (@key == -2)
  23.         goto length
  24. if (rad > 0.00001)
  25.         goto sections
  26. pause "Invalid radius ... (Press RETURN)"
  27. goto radius
  28.  
  29. :sections
  30. REM Number of parallel coaxial circles to be displayed
  31.  
  32. getint "Enter no. of transverse sections (%d) =>", 5, sect
  33. if (@key == -3)
  34.         exit
  35. if (@key == -2)
  36.         goto radius
  37. if (sect >= 1)
  38.         goto method
  39. pause "Invalid number ... (Press RETURN)"
  40. goto sections
  41.  
  42. :method
  43. REM The axis of the cylinder can be defined by two methods. TWO PTS requires
  44. REM the user to indicate two points which determine a line. The axis of the  
  45. REM cylinder is parallel to this line, but could be anywhere. This option is 
  46. REM default. PLANE lets the user indicate a plane and the cylinder axis is 
  47. REM parallel to the normal to that plane, but could be anywhere.
  48.  
  49. getmenu "Choose method for defining cylinder axis direction",\
  50.         "TWO PTS",\
  51.         "PLANE"
  52.  
  53. if (@key == -3)
  54.         exit
  55. if (@key == -2)
  56.         goto sections
  57. if (@key == 2)
  58.         goto plane
  59.  
  60. def = 3
  61. :first
  62. getpos "Indicate 1st pt. along the axis", def
  63. if (@key == -1)
  64.         goto first
  65. x1 = @xworld
  66. y1 = @yworld
  67. z1 = @zworld
  68.  
  69. if (@key == -3)
  70.         exit
  71. if (@key == -2)
  72.         goto method
  73. def = @key
  74.  
  75. :second
  76. getpos "Indicate 2nd pt. along the axis", def
  77. if (@key == -1)
  78.         goto second
  79. x2 = @xworld
  80. y2 = @yworld
  81. z2 = @zworld
  82.  
  83. def = @key
  84. if (@key == -3)
  85.         exit
  86. if (@key == -2)
  87.         goto first
  88.  
  89. REM direction vector for the cone axis has to be non-zero
  90. xn = x2 - x1
  91. yn = y2 - y1
  92. zn = z2 - z1
  93.  
  94. if ((abs(xn) > 0.00001) || \
  95.     (abs(yn) > 0.00001) || \
  96.     (abs(zn) > 0.00001))
  97.         goto unit
  98.  
  99. pause "2nd pt. is coincident with 1st pt. (Press RETURN)"
  100. goto second
  101.  
  102. :unit
  103. REM Take cross product of (0, 1, 0) with the direction vector to get x axis.
  104. REM If the result is a zero vector, the dirction vector is parallel to 
  105. REM (0, 1, 0), so take direction vector cross (1, 0, 0) to get y axis. Once 
  106. REM the x axis or y axis is determined, find the remaining axis by taking
  107. REM cross of the direction vector and the axis determined, thus completing 
  108. REM the orthogonal basis
  109.  
  110. call cross, xx, xy, xz, 0, 1, 0, xn, yn, zn
  111.  
  112. if ((abs(xx) < 0.00001) && \
  113.     (abs(xy) < 0.00001) && \
  114.     (abs(xz) < 0.00001))
  115.         goto use_x
  116.  
  117. call cross, yx, yy, yz, xn, yn, zn, xx, xy, xz
  118. goto vmatrix
  119.  
  120. :use_x
  121. call cross, yx, yy, yz, xn, yn, zn, 1, 0, 0
  122. call cross, xx, xy, xz, yx, yy, yz, xn, yn, zn
  123.  
  124. :vmatrix
  125. REM Determine the vector magnitudes and convert the orthogonal basis to a
  126. REM orthnormal basis
  127.  
  128. mn = sqrt(xn*xn + yn*yn + zn*zn)
  129. mx = sqrt(xx*xx + xy*xy + xz*xz)
  130. my = sqrt(yx*yx + yy*yy + yz*yz)
  131.  
  132. REM Define the view matrix for the new view and go to defining the view
  133.  
  134. vmat[0] = xx/mx
  135. vmat[1] = yx/my
  136. vmat[2] = xn/mn
  137. vmat[3] = xy/mx
  138. vmat[4] = yy/my
  139. vmat[5] = yn/mn
  140. vmat[6] = xz/mx
  141. vmat[7] = yz/my
  142. vmat[8] = zn/mn
  143. goto def_view
  144.  
  145. :plane
  146. REM If the PLANE option is chosen, get the view matrix by GETPLANE command
  147.  
  148. getplane "Define plane for 1st face", 1
  149.  
  150. if (@key == -3)
  151.         exit
  152. if (@key == -2)
  153.         goto method
  154.  
  155. getmenu "Accept plane (YES) ? ",\
  156.         "NO",\
  157.         "YES"
  158.  
  159. on (@key+3) goto exit, plane, , , plane, plmat
  160.  
  161. :plmat
  162. vmat[0] = @fltdat[1]
  163. vmat[1] = @fltdat[2]
  164. vmat[2] = @fltdat[3]
  165. vmat[3] = @fltdat[4]
  166. vmat[4] = @fltdat[5]
  167. vmat[5] = @fltdat[6]
  168. vmat[6] = @fltdat[7]
  169. vmat[7] = @fltdat[8]
  170. vmat[8] = @fltdat[9]
  171.  
  172. :def_view
  173. REM define the view with ref. no. 10
  174.  
  175. view 10, vmat[0], vmat[1], vmat[2],\
  176.          vmat[3], vmat[4], vmat[5],\
  177.          vmat[6], vmat[7], vmat[8]
  178.  
  179. :directrix
  180. REM draw the directrix arrow to indicate the direction of the normal and 
  181. REM determine which direction the cone should be extended.
  182.  
  183. mode draw
  184. dx = vmat[2]/(2*@scale)
  185. dy = vmat[5]/(2*@scale)
  186. dz = vmat[8]/(2*@scale)
  187. line @xworld, @yworld, @zworld, @xworld+dx, @yworld+dy, @zworld+dz, 15
  188. call xfmwv, vmat, @xworld+dx, @yworld+dy, @zworld+dz, xc, yc, zc
  189. arr = 0.1/@scale
  190. circle xc, yc, zc, arr, 10, 15
  191. vline xc+arr, yc, zc, xc, yc, zc+2*arr, 10, 15
  192. vline xc-arr, yc, zc, xc, yc, zc+2*arr, 10, 15
  193. vline xc, yc+arr, zc, xc, yc, zc+2*arr, 10, 15
  194. vline xc, yc-arr, zc, xc, yc, zc+2*arr, 10, 15
  195. mode normal
  196.  
  197. :dir
  198. getmenu "Draw cylinder in arrow direction or opposite direction ?",\
  199.         "ARROW",\
  200.         "OPPOSE"
  201.  
  202. if (@key == -3)
  203.         exit
  204. if (@key == -2)
  205.         goto method
  206. if (@key == 2)
  207.         len = -len 
  208.  
  209. def = 1
  210. :draw
  211. getpos "Indicate position for face center", def
  212. if (@key == -1)
  213.         goto draw
  214. if (@key == -3)
  215.         exit
  216. if (@key == -2)
  217.         len = abs(len)
  218. if (@key == -2)
  219.         goto dir
  220.  
  221. def = @key
  222. x1 = @xworld
  223. y1 = @yworld
  224. z1 = @zworld
  225.  
  226. call xfmwv, vmat, x1, y1, z1, xc, yc, zc
  227.  
  228. REM Increment the total group number and check for overflow
  229.  
  230. ptot = ptot + 1
  231. IF (ptot > 128)
  232.     goto overflow
  233.  
  234. REM Name and make the group.
  235.  
  236. sprint $grp, "_cyl%d", ptot
  237. group $grp, ptot, 2
  238.  
  239. inc = len/sect
  240.  
  241. circle xc, yc, zc, rad, 10,,,, ptot, 2
  242. i = 1
  243. if (sect == 1)
  244.         goto one
  245. :loop
  246. circle xc, yc, zc+i*inc, rad, 10,,,, ptot, 1
  247. i = i+1
  248. if (i < sect)
  249.         goto loop
  250.  
  251. :one
  252. circle xc, yc, zc+i*inc, rad, 10,,,, ptot, 2
  253.  
  254. vline xc+rad, yc, zc, xc+rad, yc, zc+len, 10,,,, ptot, 2
  255. vline xc, yc+rad, zc, xc, yc+rad, zc+len, 10,,,, ptot, 1
  256. vline xc-rad, yc, zc, xc-rad, yc, zc+len, 10,,,, ptot, 1
  257. vline xc, yc-rad, zc, xc, yc-rad, zc+len, 10,,,, ptot, 1
  258. goto draw
  259.  
  260. :overflow
  261. pause "Group overflow ... Abnormal termination"
  262. abort
  263.  
  264. :exit
  265. exit
  266.