home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p034 / 2.ddi / ARCA / USERDEF / ASMBL.CCC next >
Encoding:
Text File  |  1993-07-26  |  1.8 KB  |  124 lines
  1. %asmbl.ccc
  2. * create new file from selected entities, replace selection group by the file
  3. *NEW* 31/3/92 Rachel
  4. :w
  5. * check geometric mode activity (c100=' ')
  6. ascii c100 r13
  7. if r13 eq 32 :a
  8. mess illegal command, use \GEOM first !
  9. getwe
  10. goto :w
  11. :a
  12. mess name of extract file (1-8 char.)
  13. :b
  14. getc c1 8
  15. ascii c1 r1
  16. if r1 eq 32 :t
  17. c80=' '
  18. c81 3 ='iii'
  19. c85 =' '
  20. r80=1
  21. r83=0
  22. r88=1
  23. command chkfil
  24. if r83 eq 0 :g
  25. :t
  26. mess Error, invalid file name, enter name again :
  27. goto :b
  28. :g
  29. if r80 eq 0 :e
  30. if r89 eq 1 :e
  31. r1=0
  32. mess file " #c1 8 " already exists, wish to overwrite ? <n>
  33. def 'n'
  34. getyn r1
  35. if r1 eq 0 :a
  36. :e
  37. mess new origin point (<ENTER> for no change)
  38. p1=0 0 0
  39. getp+ p1
  40. if r93 eq 0 :f
  41. r93=999
  42. :f
  43. c9='e'
  44. ovl dumb
  45. i49=1
  46. *mess wish to delete the extracted entities from source file ? <n>
  47. r7=1
  48. *r7=0;*def 'n'
  49. *getyn r7
  50. if r7 eq 0 :o
  51. r2=999
  52. *--erase the selection group.
  53. savep
  54. c1='2'
  55. r2=0
  56. ovl dele
  57. if r2 eq 0 :N
  58. c1='d'
  59. ovl mwdel
  60. r2=0
  61. if r1 ne 100 :E
  62. r2=100
  63. r1=99
  64. :E
  65. if r1 ne 99 :C
  66. c1='R'
  67. ovl $wfix
  68. if r2 ne 100 :X
  69. if r1 ne 0 :X
  70. r1=98
  71. :C
  72. if r1 eq 98 :D
  73. goto :X
  74. :D
  75. c1='D'
  76. ovl regarc
  77. :X
  78. if r1 eq 0 :N
  79. if r1 eq 1 :1
  80. if r1 eq 3 :3
  81. if r1 eq 4 :4
  82. :1
  83. mess illegal operation, problem in data base
  84. getwe
  85. goto :Z
  86. :3
  87. mess could not create wall entities file
  88. getwe
  89. goto :Z
  90. :4
  91. mess could not open wall entities file
  92. getwe
  93. goto :Z
  94. :N
  95. restp
  96. * ----end selection group.
  97. :o
  98. c20='a'
  99. r1=0;
  100. * load the file
  101. r2 = 0
  102. c10 = 'j'
  103. ovl rdumb
  104. if r2 lt 0 :y
  105. goto :z
  106. :y
  107. mess unable to access the extracted file (press <ENTER>)
  108. getwe
  109. goto :Z
  110. :z
  111. *if r93 eq 999 :Y
  112. if p1 eq p2 :Y
  113. c9=c8;c8=c7;c7=c6;c6=c5;c5=c4;c4=c3;c3=c2;c2=c1
  114. c1='7'
  115. p2=0 0 0
  116. ovl movret
  117. :Y
  118. * place the extract file
  119. r1=1;r2=1;r3=1
  120. c1=c2;c2=c3;c3=c4;c4=c5;c5=c6;c6=c7;c7=c8;c8=c9
  121. c9='1'
  122. ovl place
  123. :Z
  124.