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