home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p068 / 4.img / BLOCK.CDL < prev    next >
Encoding:
Text File  |  1989-01-04  |  11.7 KB  |  481 lines
  1. REM  @(#)CADKEY SOLIDS    block.cdl    2.2    10/31/88
  2. REM Program to draw a block entity
  3. array vmat[9]
  4.  
  5. :block
  6. REM Get the X-Y plane. CUR-SYS option means choose the current system X-Y
  7. REM plane (view or world, depending on the view/world switch setting). 
  8. REM DEFINE option lets the user define the X-Y plane.
  9.  
  10. getmenu "Choose X-Y plane option",\
  11.         "VIEW",\
  12.         "WORLD",\
  13.         "DEFINE"
  14.  
  15. if (@key <= -2)
  16.         exit
  17. if (@key == 3)
  18.         goto define
  19.  
  20. REM set view/world switch 
  21.  
  22. vwwld = 1
  23. if (abs(@key) == 1)
  24.         vwwld = 0
  25.  
  26. REM vnum defines the view number to use for drawing the VLINEs.
  27. REM vnum = 0 means current view, vnum = 10 means user defined view.
  28. vnum = 0
  29.  
  30. :view
  31. REM This portion is executed when CUR-SYS (default) option is selected.
  32. REM CORNERS option lets the user pick two corners in the current system
  33. REM X-Y plane and then enter displacement (positive or negative) along the
  34. REM Z-axis to define the block.
  35.  
  36. getmenu "Choose block defining option",\
  37.         "CORNERS",\
  38.         "VALUES"
  39.  
  40. on (@key + 3) goto exit, block, corners, , corners, values
  41.  
  42. :corners
  43. REM To define the corners, each GETPOS command is followed by a check on the
  44. REM vwwld variable (view/world setting stored previously) to determine which
  45. REM set of coordinates  should be read. 
  46.  
  47. def = 1
  48.  
  49. :view_1
  50. getpos "Indicate 1st corner", def
  51. if (@key == -1)
  52.         goto view_1
  53. if (vwwld == 1)
  54.         goto wld_1st
  55. x1 = @xview
  56. y1 = @yview
  57. z1 = @zview
  58. goto check1
  59.  
  60. :wld_1st
  61. x1 = @xworld
  62. y1 = @yworld
  63. z1 = @zworld
  64.  
  65. :check1
  66. if (@key == -3)
  67.         exit
  68. if (@key == -2)
  69.         goto view
  70. def = @key
  71.  
  72. :view_2
  73. getpos "Indicate 2nd corner", def
  74. if (@key == -1)
  75.         goto view_2
  76. if (vwwld == 1)
  77.         goto wld_2nd
  78. xc = @xview - x1
  79. yc = @yview - y1
  80. zc = @zview - z1
  81. goto check2
  82.  
  83. :wld_2nd
  84. REM xc, yc and zc store the distances between the points in current x, y and
  85. REM z directions. The corners must define a rectangle in the X-Y plane
  86. REM (xc > 0, yc > 0) and have to be in the plane selected (zc = 0)
  87.  
  88. xc = @xworld - x1
  89. yc = @yworld - y1
  90. zc = @zworld - z1
  91.  
  92. :check2
  93. if (@key == -3)
  94.         exit
  95. if (@key == -2)
  96.         goto view_1
  97. def = @key
  98. if ((abs(xc) > 0.00001) && \
  99.     (abs(yc) > 0.00001) && \
  100.     (abs(zc) < 0.00001))
  101.         goto length
  102. pause "Invalid point ... (Press RETURN)"
  103. goto view_2
  104.  
  105. :length
  106. REM The defined rectangle in the X-Y plane will be projected along the Z-axis
  107. REM in either positive or negative direction by a non-zero displacement.
  108.  
  109. getflt "Displacement along Z axis (%f) =>", 1.00, zc
  110. if (@key == -3)
  111.         exit
  112. if (@key == -2)
  113.         goto view_2
  114.  
  115. REM After the two points and the displacement have been entered, set the
  116. REM return flag to compute the return area and goto the block drawing part.
  117.  
  118. if (abs(zc) > 0.00001)
  119.         ret_flag = 0
  120. if (abs(zc) > 0.00001)
  121.         goto calc
  122.  
  123. pause "Invalid displacement ... (Press RETURN)"
  124. goto length
  125.  
  126. :values
  127. REM If the VALUES option is selected after CUR-SYS, three positive lengths
  128. REM have to be entered (along current x, y, and z axes), and the origin 
  129. REM point for the block indicated
  130.  
  131. def = 1
  132. getflt "Length along X axis (%f) =>", 1.00, xc
  133. if (@key == -3)
  134.         exit
  135. if (@key == -2)
  136.         goto view
  137. if (abs(xc) > 0.00001)
  138.         goto y_val
  139. pause "Invalid length ... (Press RETURN)"
  140. goto values 
  141.  
  142. :y_val
  143. getflt "Length along Y axis (%f) =>", 1.00, yc
  144. if (@key == -3)
  145.         exit
  146. if (@key == -2)
  147.         goto values
  148. if (abs(yc) > 0.00001)
  149.         goto z_val
  150. pause "Invalid length ... (Press RETURN)"
  151. goto y_val
  152.  
  153. :z_val
  154. getflt "Length along Z axis (%f) =>", 1.00, zc
  155. if (@key == -3)
  156.         exit
  157. if (@key == -2)
  158.         goto y_val
  159. if (abs(zc) > 0.00001)
  160.         goto insert
  161. pause "Invalid length ... (Press RETURN)"
  162. goto z_val 
  163.  
  164. :insert
  165. REM View or World origin point coordinates are read, depending on vwwld.
  166. getpos "Indicate corner point", def
  167. if (@key == -1)
  168.         goto insert
  169. if (vwwld == 1)
  170.         goto wld_inst
  171. x1 = @xview
  172. y1 = @yview
  173. z1 = @zview
  174. goto chk_inst
  175.  
  176. :wld_inst
  177. x1 = @xworld
  178. y1 = @yworld
  179. z1 = @zworld
  180.  
  181. :chk_inst
  182. if (@key == -3)
  183.         exit
  184. if (@key == -2)
  185.         goto z_val
  186. def = @key
  187.  
  188. REM After the three lengths and the origin point have been entered, set the
  189. REM return flag to compute the return area and goto the block drawing part.
  190.  
  191. ret_flag = 1
  192. goto calc
  193.  
  194. :define
  195. REM If the DEFINE option has been selected from the BLOCK menu, the user will
  196. REM define the X-Y plane. The block will be drawn in  this new view, so the
  197. REM vwwld switch is set to 0 (view) and vnum to 10 (user defined).
  198.  
  199. vwwld = 0
  200. vnum = 10
  201.  
  202. :plane
  203. getplane "Indicate X-Y plane for the block", 1
  204.  
  205. if (@key == -3)
  206.         exit
  207. if (@key == -2)
  208.         goto block
  209.  
  210. getmenu "Accept plane (YES) ? ",\
  211.         "NO",\
  212.         "YES"
  213.  
  214. on (@key+3) goto exit, plane, , , plane, plmat
  215.  
  216. :plmat
  217. REM origin point for the trinomen.
  218.  
  219. call xfvw, @xmax-0.75/@scale, @ymax-0.75/@scale, 0.0, x1, y1, z1
  220.  
  221. REM define the view matrix and the view with ref no. 10
  222.  
  223. vmat[0] = @fltdat[1]
  224. vmat[1] = @fltdat[2]
  225. vmat[2] = @fltdat[3]
  226. vmat[3] = @fltdat[4]
  227. vmat[4] = @fltdat[5]
  228. vmat[5] = @fltdat[6]
  229. vmat[6] = @fltdat[7]
  230. vmat[7] = @fltdat[8]
  231. vmat[8] = @fltdat[9]
  232.  
  233. :def_view
  234. view 10, vmat[0], vmat[1], vmat[2],\
  235.          vmat[3], vmat[4], vmat[5],\
  236.          vmat[6], vmat[7], vmat[8]
  237.  
  238. :trinomen
  239. mode draw
  240. getview @view
  241. REM Draw line of magnitude 1/2 in X unit vector direction with "X" at its end
  242.  
  243. call dotprod, vmat[0], vmat[3], vmat[6], @fltdat[2], @fltdat[5], @fltdat[8], r
  244. if (r < 0)
  245.         ltype = 2
  246. if (r >= 0)
  247.         ltype = 1
  248.  
  249. dx = vmat[0]/(2*@scale)
  250. dy = vmat[3]/(2*@scale)
  251. dz = vmat[6]/(2*@scale)
  252. line x1, y1, z1, x1+dx, y1+dy, z1+dz, 15, , ltype
  253. arr = 0.15/@scale
  254. call xfwv, x1+1.3*dx, y1+1.3*dy, z1+1.3*dz, xc, yc, zc
  255. text xc, yc, "x", 0, arr, 0.7, 0, 15
  256.  
  257. REM Draw line of magnitude 1/2 in Y unit vector direction with "Y" at its end
  258.  
  259. call dotprod, vmat[1], vmat[4], vmat[7], @fltdat[2], @fltdat[5], @fltdat[8], r
  260. if (r < 0)
  261.         ltype = 2
  262. if (r >= 0)
  263.         ltype = 1
  264.  
  265. dx = vmat[1]/(2*@scale)
  266. dy = vmat[4]/(2*@scale)
  267. dz = vmat[7]/(2*@scale)
  268. line x1, y1, z1, x1+dx, y1+dy, z1+dz, 15, , ltype
  269. call xfwv, x1+1.3*dx, y1+1.3*dy, z1+1.3*dz, xc, yc, zc
  270. text xc, yc, "y", 0, arr, 0.7, 0, 15
  271.  
  272. REM Draw line of magnitude 1/2 in Z unit vector direction with "Z" at its end
  273.  
  274. call dotprod, vmat[2], vmat[5], vmat[8], @fltdat[2], @fltdat[5], @fltdat[8], r
  275. if (r < 0)
  276.         ltype = 2
  277. if (r >= 0)
  278.         ltype = 1
  279.  
  280. dx = vmat[2]/(2*@scale)
  281. dy = vmat[5]/(2*@scale)
  282. dz = vmat[8]/(2*@scale)
  283. line x1, y1, z1, x1+dx, y1+dy, z1+dz, 15, , ltype
  284. call xfwv, x1+1.3*dx, y1+1.3*dy, z1+1.3*dz, xc, yc, zc
  285. text xc, yc, "z", 0, arr, 0.7, 0, 15
  286. mode normal
  287.  
  288. :def2
  289. REM After the user has defined the X-Y plane, the same options as CUR_SYS
  290. REM are available specify the block parameter
  291.  
  292. getmenu "Choose block defining option",\
  293.         "CORNERS",\
  294.         "VALUES"
  295.  
  296. on (@key + 3) goto exit, block, corners2, , corners2, values2
  297.  
  298. :corners2
  299. REM CORNERS option lets the user pick two corners in the user defined
  300. REM X-Y plane and then enter displacement (positive or negative) along the
  301. REM Z-axis to define the block.
  302. def = 1
  303.  
  304. :pos_1
  305. getpos "Indicate 1st corner", def
  306. if (@key == -1)
  307.         goto pos_1
  308. call xfmwv, vmat, @xworld, @yworld, @zworld, x1, y1, z1
  309.  
  310. if (@key == -3)
  311.         exit
  312. if (@key == -2)
  313.         goto def2
  314. def = @key
  315.  
  316. :pos_2
  317. getpos "Indicate 2nd corner", def
  318. if (@key == -1)
  319.         goto pos_2
  320. call xfmwv, vmat, @xworld, @yworld, @zworld, x2, y2, z2
  321.  
  322. if (@key == -3)
  323.         exit
  324. if (@key == -2)
  325.         goto pos_1
  326.  
  327. def = @key
  328.  
  329. REM xc, yc and zc store the distances between the points in user defined x,
  330. REM y and z directions. The corners must define a rectangle in the X-Y plane
  331. REM (xc > 0, yc > 0) and have to be in the plane selected (zc = 0)
  332.  
  333. xc = x2 - x1
  334. yc = y2 - y1
  335. zc = z2 - z1
  336.  
  337. if ((abs(xc) > 0.00001) && \
  338.     (abs(yc) > 0.00001) && \
  339.     (abs(zc) < 0.00001))
  340.         goto length2
  341. pause "Invalid point ... (Press RETURN)"
  342. goto pos_2
  343.  
  344. :length2
  345. REM The defined rectangle in the X-Y plane will be projected along the Z-axis
  346. REM in either positive or negative direction by a non-zero displacement.
  347.  
  348. getflt "Displacement along Z axis (%f) =>", 1.00, zc
  349. if (@key == -3)
  350.         exit
  351. if (@key == -2)
  352.         goto pos_2
  353.  
  354. REM After the two points and the displacement have been entered, set the
  355. REM return flag to compute the return area and goto the block drawing part.
  356.  
  357. if (abs(zc) > 0.00001)
  358.         ret_flag = 2
  359. if (abs(zc) > 0.00001)
  360.         goto calc
  361. pause "Invalid displacement ... (Press RETURN)"
  362. goto length2
  363.  
  364. :values2
  365. REM If the VALUES option is selected after DEFINE, three positive lengths
  366. REM have to be entered (along user defined x, y, and z axes), and the origin 
  367. REM point for the block
  368.  
  369. def = 1
  370. getflt "Length along X axis (%f) =>", 1.00, xc
  371. if (@key == -3)
  372.         exit
  373. if (@key == -2)
  374.         goto def2
  375. if (abs(xc) > 0.00001)
  376.         goto y_val2
  377. pause "Invalid length ... (Press RETURN)"
  378. goto values2 
  379.  
  380. :y_val2
  381. getflt "Length along Y axis (%f) =>", 1.00, yc
  382. if (@key == -3)
  383.         exit
  384. if (@key == -2)
  385.         goto values2
  386. if (abs(yc) > 0.00001)
  387.         goto z_val2
  388. pause "Invalid length ... (Press RETURN)"
  389. goto y_val2 
  390.  
  391. :z_val2
  392. getflt "Length along Z axis (%f) =>", 1.00, zc
  393. if (@key == -3)
  394.         exit
  395. if (@key == -2)
  396.         goto y_val2
  397. if (abs(zc) > 0.00001)
  398.         goto insert2
  399. pause "Invalid length ... (Press RETURN)"
  400. goto z_val2
  401.  
  402. :insert2
  403. REM Defined View origin point coordinates are read by tranformation.
  404.  
  405. getpos "Indicate corner point", def
  406. if (@key == -1)
  407.         goto insert2
  408. call xfmwv, vmat, @xworld, @yworld, @zworld, x1, y1, z1
  409.  
  410. if (@key == -3)
  411.         exit
  412. if (@key == -2)
  413.         goto z_val2
  414.  
  415. REM After the three lengths and the origin point have been entered, set the
  416. REM return flag to compute the return area and goto the block drawing part.
  417.  
  418. ret_flag = 3
  419.  
  420. :calc
  421. REM Increment the total group number and check for overflow
  422.  
  423. ptot = ptot + 1
  424. IF (ptot > 128)
  425.     goto overflow
  426.  
  427. REM Name and make the group.
  428.  
  429. sprint $grp, "_blk%d", ptot
  430. group $grp, ptot, 1
  431.  
  432. if (vwwld == 0)
  433.         goto draw_view
  434.  
  435. :draw_wld
  436. line x1, y1, z1, x1+xc, y1, z1,,,, ptot, 1
  437. line x1+xc, y1, z1, x1+xc, y1+yc, z1,,,, ptot, 1
  438. line x1+xc, y1+yc, z1, x1, y1+yc, z1,,,, ptot, 1
  439. line x1, y1+yc, z1, x1, y1, z1,,,, ptot, 1
  440.  
  441. line x1, y1, z1, x1, y1, z1+zc,,,, ptot, 1
  442. line x1+xc, y1, z1, x1+xc, y1, z1+zc,,,, ptot, 1
  443. line x1+xc, y1+yc, z1, x1+xc, y1+yc, z1+zc,,,, ptot, 1
  444. line x1, y1+yc, z1, x1, y1+yc, z1+zc,,,, ptot, 1
  445.  
  446. line x1, y1, z1+zc, x1+xc, y1, z1+zc,,,, ptot, 1
  447. line x1+xc, y1, z1+zc, x1+xc, y1+yc, z1+zc,,,, ptot, 1
  448. line x1+xc, y1+yc, z1+zc, x1, y1+yc, z1+zc,,,, ptot, 1
  449. line x1, y1+yc, z1+zc, x1, y1, z1+zc,,,, ptot, 1
  450. goto return
  451.  
  452. :draw_view
  453. vline x1, y1, z1, x1+xc, y1, z1, vnum,,,, ptot, 1
  454. vline x1+xc, y1, z1, x1+xc, y1+yc, z1, vnum,,,, ptot, 1
  455. vline x1+xc, y1+yc, z1, x1, y1+yc, z1, vnum,,,, ptot, 1
  456. vline x1, y1+yc, z1, x1, y1, z1, vnum,,,, ptot, 1
  457.  
  458. vline x1, y1, z1, x1, y1, z1+zc, vnum,,,, ptot, 1
  459. vline x1+xc, y1, z1, x1+xc, y1, z1+zc, vnum,,,, ptot, 1
  460. vline x1+xc, y1+yc, z1, x1+xc, y1+yc, z1+zc, vnum,,,, ptot, 1
  461. vline x1, y1+yc, z1, x1, y1+yc, z1+zc, vnum,,,, ptot, 1
  462.  
  463. vline x1, y1, z1+zc, x1+xc, y1, z1+zc, vnum,,,, ptot, 1
  464. vline x1+xc, y1, z1+zc, x1+xc, y1+yc, z1+zc, vnum,,,, ptot, 1
  465. vline x1+xc, y1+yc, z1+zc, x1, y1+yc, z1+zc, vnum,,,, ptot, 1
  466. vline x1, y1+yc, z1+zc, x1, y1, z1+zc, vnum,,,, ptot, 1
  467.  
  468. :return
  469.  
  470. REM After drawing the block, return to the appropriate part
  471.  
  472. on (ret_flag) goto view_1, insert, pos_1, insert2
  473.  
  474. :exit
  475. exit
  476.  
  477. :overflow
  478. pause "Group overflow ... Abnormal termination"
  479. abort
  480.  
  481.