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 / GMUPDATE.CDL < prev    next >
Encoding:
Text File  |  1989-05-22  |  6.6 KB  |  290 lines
  1. REM     name:     gmupdate.cdl
  2.  
  3. REM     date:     020189 simon izraelevitz
  4.  
  5. REM     task:     redefines a geometric entity by updating date base
  6. REM               data.
  7.  
  8. REM     -----------------------------------------------
  9.  
  10.    CLEAR
  11.    ARRAY  vm[9]
  12.    ARRAY  pvm[9]
  13.    PI = 3.1415926536
  14.    radang = 180/PI
  15.  
  16. REM     *** default definition view.
  17.    defview = -1
  18.  
  19. :get_ent
  20. REM     *** get entity to update
  21.    SET mask
  22.    GETENT  "Indicate entity", etype
  23.    ON (@key + 3) GOTO exit,exit,get_ent,
  24.  
  25. REM     *** define new view if it is different from the default view.
  26. :chk_view
  27.    prview = @VIEW
  28.    IF (prview != defview)
  29.       GETVIEW prview,pvm
  30.    VIEW 1,pvm[0],pvm[1],pvm[2],pvm[3],pvm[4],pvm[5],pvm[6],pvm[7],pvm[8]
  31.    defview = prview
  32.  
  33.    ON (etype - 1) GOTO point,line,arc,
  34.  
  35. :point
  36.    x = @FLTDAT[0]
  37.    y = @FLTDAT[1]
  38.    z = @FLTDAT[2]
  39.  
  40. :pt_prompt1
  41.    SPRINT $pmpt, "WORLD:  X= %f   Y= %f   Z= %f", x, y, z
  42.  
  43. :pt_menu1
  44.    GETMENU $pmpt,\
  45.      "CHG X",\
  46.      "CHG Y",\
  47.      "CHG Z"
  48. key=@key
  49.    ON (key + 3) GOTO exit, get_ent,pt_map,pt_menu1,pxw,pyw,pzw
  50.  
  51. :pxw
  52.    GETFLT "X (%f) = ",x,x
  53.    ON (@KEY + 3) GOTO exit, pt_prompt1,pt_prompt1
  54. :pyw
  55.    GETFLT "Y (%f) = ",y,y
  56.    ON (@KEY + 3) GOTO exit, pt_prompt1,pt_prompt1
  57. :pzw
  58.    GETFLT "Z (%f) = ",z,z
  59.    ON (@KEY + 3) GOTO exit, pt_prompt1,pt_prompt1
  60.  
  61. :pt_map
  62.    CALL xfmwv, pvm, x, y, z, xv, yv, zv
  63.  
  64. :pt_prompt2
  65.    SPRINT $pmpt, "VIEW:  XV= %f   YV= %f   ZV= %f", xv, yv, zv
  66.  
  67. :pt_menu2
  68.    GETMENU $pmpt,\
  69.      "CHG XV",\
  70.      "CHG YV",\
  71.      "CHG ZV"
  72.    ON (@key + 3) GOTO exit, pt_prompt1,make_pt,pt_menu2,pxv,pyv,pzv
  73.  
  74. :pxv
  75.    GETFLT "XV (%f) = ",xv,xv
  76.    ON (@KEY + 3) GOTO exit, pt_prompt2,pt_prompt2
  77. :pyv
  78.    GETFLT "YV (%f) = ",yv,yv
  79.    ON (@KEY + 3) GOTO exit, pt_prompt2,pt_prompt2
  80. :pzv
  81.    GETFLT "ZV (%f) = ",zv,zv
  82.    ON (@KEY + 3) GOTO exit, pt_prompt2,pt_prompt2
  83.  
  84. :make_pt
  85.    CALL xfmvw, pvm, xv, yv, zv, x, y, z
  86.    DELENT
  87.    POINT x,y,z
  88.    GOTO get_ent
  89.  
  90. :line
  91.    x1 = @FLTDAT[0]
  92.    y1 = @FLTDAT[1]
  93.    z1 = @FLTDAT[2]
  94.    x2 = @FLTDAT[3]
  95.    y2 = @FLTDAT[4]
  96.    z2 = @FLTDAT[5]
  97.  
  98. :ln_prompt1
  99.    SPRINT $pmpt, "WORLD:  X1= %f   Y1= %f   Z1= %f", x1, y1, z1
  100.  
  101. :ln_menu1
  102.    MODE DRAW
  103.    POINT x1,y1,z1,5
  104.    MODE NORMAL
  105.    GETMENU $pmpt,\
  106.      "CHG X1",\
  107.      "CHG Y1",\
  108.      "CHG Z1"
  109.    ON (@key + 3) GOTO exit, get_ent,ln_prompt2,ln_menu1,px1,py1,pz1
  110.  
  111. :px1
  112.    GETFLT "X1 (%f) = ",x1,x1
  113.    ON (@KEY + 3) GOTO exit, ln_prompt1,ln_prompt1
  114. :py1
  115.    GETFLT "Y1 (%f) = ",y1,y1
  116.    ON (@KEY + 3) GOTO exit, ln_prompt1,ln_prompt1
  117. :pz1
  118.    GETFLT "Z1 (%f) = ",z1,z1
  119.    ON (@KEY + 3) GOTO exit, ln_prompt1,ln_prompt1
  120.  
  121. :ln_prompt2
  122.    SPRINT $pmpt, "WORLD:  X2= %f   Y2= %f   Z2= %f", x2, y2, z2
  123.  
  124. :ln_menu2
  125.    GETMENU $pmpt,\
  126.      "CHG X2",\
  127.      "CHG Y2",\
  128.      "CHG Z2"
  129.    ON (@key + 3) GOTO exit, ln_prompt1,ln_map,ln_menu2,px2,py2,pz2
  130.  
  131. :px2
  132.    GETFLT "X2 (%f) = ",x2,x2
  133.    ON (@KEY + 3) GOTO exit, ln_prompt2,ln_prompt2
  134. :py2
  135.    GETFLT "Y2 (%f) = ",y2,y2
  136.    ON (@KEY + 3) GOTO exit, ln_prompt2,ln_prompt2
  137. :pz2
  138.    GETFLT "Z2 (%f) = ",z2,z2
  139.    ON (@KEY + 3) GOTO exit, ln_prompt2,ln_prompt2
  140.  
  141. :ln_map
  142.    CALL xfmwv, pvm, x1, y1, z1, xv1, yv1, zv1
  143.    CALL xfmwv, pvm, x2, y2, z2, xv2, yv2, zv2
  144.  
  145. :ln_prompt3
  146.    SPRINT $pmpt, "VIEW:  XV1= %f   YV1= %f   ZV1= %f", xv1, yv1, zv1
  147.  
  148. :ln_menu3
  149.    GETMENU $pmpt,\
  150.      "CHG XV1",\
  151.      "CHG YV1",\
  152.      "CHG ZV1"
  153.    ON (@key + 3) GOTO exit, ln_prompt2,ln_prompt4,ln_menu3,pxv1,pyv1,pzv1
  154.  
  155. :pxv1
  156.    GETFLT "XV1 (%f) = ",xv1,xv1
  157.    ON (@KEY + 3) GOTO exit, ln_prompt3,ln_prompt3
  158. :pyv1
  159.    GETFLT "YV1 (%f) = ",yv1,yv1
  160.    ON (@KEY + 3) GOTO exit, ln_prompt3,ln_prompt3
  161. :pzv1
  162.    GETFLT "ZV1 (%f) = ",zv1,zv1
  163.    ON (@KEY + 3) GOTO exit, ln_prompt3,ln_prompt3
  164.  
  165. :ln_prompt4
  166.    SPRINT $pmpt, "VIEW:  XV2= %f   YV2= %f   ZV2= %f", xv2, yv2, zv2
  167.  
  168. :ln_menu4
  169.    GETMENU $pmpt,\
  170.      "CHG XV2",\
  171.      "CHG YV2",\
  172.      "CHG ZV2"
  173.    ON (@key + 3) GOTO exit, ln_prompt3,make_ln,ln_menu4,pxv2,pyv2,pzv2
  174.  
  175. :pxv2
  176.    GETFLT "XV2 (%f) = ",xv2,xv2
  177.    ON (@KEY + 3) GOTO exit, ln_prompt4,ln_prompt4
  178. :pyv2
  179.    GETFLT "YV1 (%f) = ",yv1,yv1
  180.    ON (@KEY + 3) GOTO exit, ln_prompt4,ln_prompt4
  181. :pzv2
  182.    GETFLT "ZV1 (%f) = ",zv1,zv1
  183.    ON (@KEY + 3) GOTO exit,ln_prompt4,ln_prompt4
  184.  
  185. :make_ln
  186.    CALL xfmvw, pvm, xv1, yv1, zv1, x1, y1, z1
  187.    CALL xfmvw, pvm, xv2, yv2, zv2, x2, y2, z2
  188.    DELENT
  189.    LINE x1,y1,z1,x2,y2,z2
  190.    GOTO get_ent
  191.  
  192. :arc
  193.    x       = @FLTDAT[0]
  194.    y       = @FLTDAT[1]
  195.    z       = @FLTDAT[2]
  196.    rad     = @FLTDAT[3]
  197.    stang   = @FLTDAT[4]*radang
  198.    endang  = @FLTDAT[5]*radang + stang
  199.  
  200. rem     *** define arc view
  201. GETVIEW @INTDAT[8]
  202.    i     = 0
  203. :vmloop
  204.    vm[i] = @FLTDAT[i]
  205.    i     = i + 1
  206.    IF (i == 9)
  207.       GOTO arc_view
  208.    GOTO vmloop
  209.  
  210. :arc_view
  211.    VIEW 1,vm[0],vm[1],vm[2],vm[3],vm[4],vm[5],vm[6],vm[7],vm[8]
  212.    CALL xfmvw, vm, x, y, z, xw, yw, zw
  213.  
  214. :arc_prompt1
  215.    SPRINT $pmpt, "WORLD:  X= %f   Y= %f   Z= %f", xw, yw, zw
  216.  
  217. :arc_menu1
  218.    MODE DRAW
  219.    POINT xw,yw,zw,5
  220.    MODE NORMAL
  221.    GETMENU $pmpt,\
  222.      "CHG X",\
  223.      "CHG Y",\
  224.      "CHG Z"
  225.    ON (@key + 3) GOTO exit, get_ent,arc_map,arc_menu1,cxw,cyw,czw
  226.  
  227. :cxw
  228.    GETFLT "X (%f) = ",xw,xw
  229.    ON (@KEY + 3) GOTO exit, arc_prompt1,arc_prompt1
  230. :cyw
  231.    GETFLT "Y (%f) = ",yw,yw
  232.    ON (@KEY + 3) GOTO exit, arc_prompt1,arc_prompt1
  233. :czw
  234.    GETFLT "Z (%f) = ",zw,zw
  235.    ON (@KEY + 3) GOTO exit, arc_prompt1,arc_prompt1
  236.  
  237. :arc_map
  238.    CALL xfmwv, pvm, xw, yw, zw, xv, yv, zv
  239.  
  240. :arc_prompt2
  241.    SPRINT $pmpt, "VIEW:  XV= %f   YV= %f   ZV= %f", xv, yv, zv
  242.  
  243. :arc_menu2
  244.    GETMENU $pmpt,\
  245.      "CHG XV",\
  246.      "CHG YV",\
  247.      "CHG ZV"
  248.    ON (@key + 3) GOTO exit, arc_prompt1,arc_prompt3,arc_menu2,cxv,cyv,czv
  249.  
  250. :cxv
  251.    GETFLT "XV (%f) = ",xv,xv
  252.    ON (@KEY + 3) GOTO exit, arc_prompt2,arc_prompt2
  253. :cyv
  254.    GETFLT "YV (%f) = ",yv,yv
  255.    ON (@KEY + 3) GOTO exit, arc_prompt2,arc_prompt2
  256. :czv
  257.    GETFLT "ZV (%f) = ",zv,zv
  258.    ON (@KEY + 3) GOTO exit, arc_prompt2,arc_prompt2
  259.  
  260.    CALL xfmvw, pvm, xv, yv, zv, xw, yw, zw
  261.    CALL xfmwv, vm, xw, yw, zw, x, y, z
  262.  
  263. :arc_prompt3
  264.    SPRINT $pmpt, "  RAD= %f   STANG= %f   ENDANG= %f",rad,stang,endang
  265.  
  266. :arc_menu3
  267.    GETMENU $pmpt,\
  268.      "CHG RAD",\
  269.      "CHG ST",\
  270.      "CHG END"
  271.    ON (@key + 3) GOTO exit,arc_prompt2,make_arc,arc_menu3,radius,st_ang,end_ang
  272.  
  273. :radius
  274.    GETFLT "Radius (%f) = ",rad,rad,
  275.    ON (@KEY + 3) GOTO exit, arc_prompt3,arc_prompt3
  276. :st_ang
  277.    GETFLT "St. Ang (%f) = ",stang,stang,
  278.    ON (@KEY + 3) GOTO exit, arc_prompt3,arc_prompt3
  279. :end_ang
  280.    GETFLT "End Ang (%f) = ",endang,endang,
  281.    ON (@KEY + 3) GOTO exit, arc_prompt3,arc_prompt3
  282.  
  283. :make_arc
  284.    DELENT
  285.    ARC x, y, z, rad, stang, endang, 1
  286.    GOTO get_ent
  287.  
  288. :exit
  289.    EXIT
  290.