home *** CD-ROM | disk | FTP | other *** search
- %oliba.ccc
- *$Header$
- *$Log$
- **************
- *add,libnam=c10 8
- *R32:0=2D,1=3D.If 2D:r33:0-obj,1,2,3-opning,4-EC
- :0
- mess add from: f-file, c-current drawing, s-selection group
- getc c1 1
- ascii c1 r13
- if r13 eq 102 :f
- if r13 eq 99 :c
- if r13 eq 115 :s
- goto :0
- :f
- mess object file name (1-8 char.)
- :w
- getc+ c1 8
- if r93 ne 0 :0
- ascii c1 r3
- if r3 eq 32 :p
- c80=' '
- c81 3 ='iii'
- c85='A'
- r80=0
- r82=0
- r83=0
- r88=1
- command chkfil
- if r83 eq 0 :A
- :p
- mess Error, invalid object name, enter name again :
- goto :w
- :A
- if r80 eq 1 :a
- mess file for object " #c1 8 " not found, enter another name :
- goto :w
- :a
- if r33 eq 0 :D
- mess is opening stretchable ?
- getyn r33
- *1=nonstr,2=str.win,3=str.door
- r33=r33+1
- if r33 eq 1 :D
- mess stretchable in 2 directions (n-only along the wall) ?
- getyn r1
- r33=r33+r1
- :D
- mess object description (1-40 char., no spaces), <ENTER>-no descr.
- *getc c211 40
- r37=0
- r38=40
- r39=211
- r1=0
- ovl getc
- if r1 ne 0 :D
- r1=0
- ovl inclib
- if r1 eq 0 :G
- if r1 ne 5 :e
- mess " #c1 8 " is already in the library, add another object ?
- goto :F
- :G
- if r13 ne 102 :q
- mess add another object ?
- :F
- getyn r1
- if r1 eq 0 :q
- goto :0
- :e
- if r1 eq 1 :1
- if r1 eq 2 :2
- if r1 eq 3 :3
- if r1 eq 4 :4
- if r1 eq 11 :6
- if r1 eq 12 :7
- if r1 eq 21 :7
- if r1 eq 22 :7
- if r1 eq 13 :5
- if r1 eq 23 :5
- if r1 eq 999 :9
- mess System Error (INCLIB, rc= #r1 )
- getwe
- goto :q
- :1
- mess Error reading " #c1 8 " - bad or empty file
- getwe
- goto :q
- :2
- mess Error adding name & description to new library object
- getwe
- goto :q
- :3
- mess Error creating $O$TMP
- getwe
- goto :q
- :4
- mess Error: " #c10 8 " is not a valid library
- getwe
- goto :q
- :6
- mess Error, cannot find the specified library
- getwe
- goto :q
- :7
- mess Error copying library to/from $O$TMP
- getwe
- goto :q
- :5
- mess Error, disk full
- getwe
- goto :q
- :9
- mess Truncated the element to maximum allowed size (press <ENTER>)
- getw
- goto :G
- :c
- *FROM CURRENT DRAWING
- mess file name to save (1-8 char.):
- def c201 8
- :b
- getc c2 8
- c201=c2;c202=c3;c203=c4;c204=c5;c205=c6;c206=c7;c207=c8;c208=c9
- c80=' '
- c81 3 ='iii'
- c85=' '
- r80=1
- r83=0
- r88=2
- command chkfil
- if r83 eq 0 :r
- mess Error, invalid file name, enter name again :
- goto :b
- :r
- if r80 eq 0 :h
- if r89 eq 1 :h
- r3=0
- mess file " #c2 8 " already exists, want to overwrite ? <n>
- def 'n'
- getyn r3
- if r3 eq 0 :c
- :h
- ovl reo
- c1='2'
- ovl autos
- c1=c2;c2=c3;c3=c4;c4=c5;c5=c6;c6=c7;c7=c8;c8=c9;c9=' '
- goto :a
- *FROM SEL.GROUP
- :s
- mess file name to save (1-8 char.)
- :v
- getc c1 8
- ascii c1 r3
- if r3 eq 32 :t
- c80=' '
- c81 3 ='iii'
- c85=' '
- r80=1
- r83=0
- r88=1
- command chkfil
- if r83 eq 0 :g
- :t
- mess Error, invalid file name, enter name again :
- goto :v
- :g
- if r80 eq 0 :x
- if r89 eq 1 :x
- r3=0
- mess file " #c1 8 " already exists, wish to overwrite ? <n>
- def 'n'
- getyn r3
- if r3 eq 0 :s
- :x
- *save c10
- c211=c10
- c9='e'
- ovl dumb
- i49=1
- c20='a'
- r1=0
- r2=0
- c10='j'
- ovl rdumb
- if r2 lt 0 :y
- *restore c10
- c10=c211
- goto :a
- :y
- mess Error accessing extracted object
- getwe
- *goto :q
- :q
- r1=999
- macro olib
-