home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p034 / 2.ddi / ARCA / USERDEF / OLIBA.CCC < prev    next >
Encoding:
Text File  |  1993-07-25  |  3.0 KB  |  196 lines

  1. %oliba.ccc
  2. *$Header$
  3. *$Log$
  4. **************
  5. *add,libnam=c10 8
  6. *R32:0=2D,1=3D.If 2D:r33:0-obj,1,2,3-opning,4-EC
  7. :0
  8. mess add from: f-file, c-current drawing, s-selection group
  9. getc c1 1
  10. ascii c1 r13
  11. if r13 eq 102 :f
  12. if r13 eq 99 :c
  13. if r13 eq 115 :s
  14. goto :0
  15. :f
  16. mess object file name (1-8 char.)
  17. :w
  18. getc+ c1 8
  19. if r93 ne 0 :0
  20. ascii c1 r3
  21. if r3 eq 32 :p
  22. c80=' '
  23. c81 3 ='iii'
  24. c85='A'
  25. r80=0
  26. r82=0
  27. r83=0
  28. r88=1
  29. command chkfil
  30. if r83 eq 0 :A
  31. :p
  32. mess Error, invalid object name, enter name again :
  33. goto :w
  34. :A
  35. if r80 eq 1 :a
  36. mess file for object " #c1 8 " not found, enter another name :
  37. goto :w
  38. :a
  39. if r33 eq 0 :D
  40. mess is opening stretchable ?
  41. getyn r33
  42. *1=nonstr,2=str.win,3=str.door
  43. r33=r33+1
  44. if r33 eq 1 :D
  45. mess stretchable in 2 directions (n-only along the wall) ?
  46. getyn r1
  47. r33=r33+r1
  48. :D
  49. mess object description (1-40 char., no spaces), <ENTER>-no descr.
  50. *getc c211 40
  51. r37=0
  52. r38=40
  53. r39=211
  54. r1=0
  55. ovl getc
  56. if r1 ne 0 :D
  57. r1=0
  58. ovl inclib
  59. if r1 eq 0 :G
  60. if r1 ne 5 :e
  61. mess " #c1 8 " is already in the library, add another object ?
  62. goto :F
  63. :G
  64. if r13 ne 102 :q
  65. mess add another object ?
  66. :F
  67. getyn r1
  68. if r1 eq 0 :q
  69. goto :0
  70. :e
  71. if r1 eq 1 :1
  72. if r1 eq 2 :2
  73. if r1 eq 3 :3
  74. if r1 eq 4 :4
  75. if r1 eq 11 :6
  76. if r1 eq 12 :7
  77. if r1 eq 21 :7
  78. if r1 eq 22 :7
  79. if r1 eq 13 :5
  80. if r1 eq 23 :5
  81. if r1 eq 999 :9
  82. mess System Error (INCLIB, rc= #r1 )
  83. getwe
  84. goto :q
  85. :1
  86. mess Error reading " #c1 8 " - bad or empty file
  87. getwe
  88. goto :q
  89. :2
  90. mess Error adding name & description to new library object
  91. getwe
  92. goto :q
  93. :3
  94. mess Error creating $O$TMP
  95. getwe
  96. goto :q
  97. :4
  98. mess Error: " #c10 8 " is not a valid library
  99. getwe
  100. goto :q
  101. :6
  102. mess Error, cannot find the specified library
  103. getwe
  104. goto :q
  105. :7
  106. mess Error copying library to/from $O$TMP
  107. getwe
  108. goto :q
  109. :5
  110. mess Error, disk full
  111. getwe
  112. goto :q
  113. :9
  114. mess Truncated the element to maximum allowed size (press <ENTER>)
  115. getw
  116. goto :G
  117. :c
  118. *FROM CURRENT DRAWING
  119. mess file name to save (1-8 char.):
  120. def c201 8
  121. :b
  122. getc c2 8
  123. c201=c2;c202=c3;c203=c4;c204=c5;c205=c6;c206=c7;c207=c8;c208=c9
  124. c80=' '
  125. c81 3 ='iii'
  126. c85=' '
  127. r80=1
  128. r83=0
  129. r88=2
  130. command chkfil
  131. if r83 eq 0 :r
  132. mess Error, invalid file name, enter name again :
  133. goto :b
  134. :r
  135. if r80 eq 0 :h
  136. if r89 eq 1 :h
  137. r3=0
  138. mess file " #c2 8 " already exists, want to overwrite ? <n>
  139. def 'n'
  140. getyn r3
  141. if r3 eq 0 :c
  142. :h
  143. ovl reo
  144. c1='2'
  145. ovl autos
  146. c1=c2;c2=c3;c3=c4;c4=c5;c5=c6;c6=c7;c7=c8;c8=c9;c9=' '
  147. goto :a
  148. *FROM SEL.GROUP
  149. :s
  150. mess file name to save (1-8 char.)
  151. :v
  152. getc c1 8
  153. ascii c1 r3
  154. if r3 eq 32 :t
  155. c80=' '
  156. c81 3 ='iii'
  157. c85=' '
  158. r80=1
  159. r83=0
  160. r88=1
  161. command chkfil
  162. if r83 eq 0 :g
  163. :t
  164. mess Error, invalid file name, enter name again :
  165. goto :v
  166. :g
  167. if r80 eq 0 :x
  168. if r89 eq 1 :x
  169. r3=0
  170. mess file " #c1 8 " already exists, wish to overwrite ? <n>
  171. def 'n'
  172. getyn r3
  173. if r3 eq 0 :s
  174. :x
  175. *save c10
  176. c211=c10
  177. c9='e'
  178. ovl dumb
  179. i49=1
  180. c20='a'
  181. r1=0
  182. r2=0
  183. c10='j'
  184. ovl rdumb
  185. if r2 lt 0 :y
  186. *restore c10
  187. c10=c211
  188. goto :a
  189. :y
  190. mess Error accessing extracted object
  191. getwe
  192. *goto :q
  193. :q
  194. r1=999
  195. macro olib
  196.