home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p034 / 2.ddi / ARCA / USERDEF / ODRAG.CCC < prev    next >
Encoding:
Text File  |  1993-03-27  |  3.0 KB  |  142 lines
  1. %odrag.ccc
  2. :k
  3. ascii c100 r13;if r13 eq 32 :5
  4. mess illegal command,use \GEOM first!
  5. getwe;goto :k
  6. :5
  7. r6=777
  8. :s
  9. sbreset
  10. :j
  11. mess wall to insert opening
  12. gete i1
  13. mess confirm choice
  14. getyn r1;unshow i1;if r1 eq 0 :j
  15. c1='w';r1=0;ovl qow
  16. if r1 lt 0 :t
  17. if r1 eq 0 :q
  18. if r1 eq 2 :l
  19. r2=0;r10=0;c1='0';i4=0;c10=' ';c11=' ';c12=' ';ovl $rub
  20. if r1 eq 5 :w
  21. if r1 eq 0 :o
  22. goto :y
  23. :q
  24. mess Error, indicated entity is not a m.wall (press <ENTER>)
  25. getw;goto :s
  26. :o
  27. if r6 eq 111 :9;r6=111
  28. r9=r81
  29. mess option: y- rectangle-shaped, n- pre-designed opening <y>
  30. r4=1;def 'y';getyn r4;if r4 eq 1 :O
  31. :0
  32. c211 8='        '
  33. mess pre-designed opening name (<ENTER> for graphic lib.)
  34. :[
  35. getc+ c211 8;if r93 eq 0 :1
  36. r81=0;c221 8='        '
  37. mess user3@-l$3dopen
  38. ovl popmnu;if r81 eq 0 :0
  39. c211=c221;c212=c222;c213=c223;c214=c224
  40. c215=c225;c216=c226;c217=c227;c218=c228
  41. :1
  42. c80=' ';c81 3='iii';c85='A';r80=0;r82=0;r83=0;r88=211;command chkfil
  43. if r83 eq 0 :F
  44. mess Error, invalid file name, enter name again:
  45. goto :[
  46. :F
  47. if r80 eq 1 :G
  48. mess file " #c211 8 " does not exist, enter another name:
  49. goto :[
  50. :G
  51. if r82 eq 1 :O
  52. mess file " #c211 8 " is empty, enter another name:
  53. goto :[
  54. :O
  55. r81=r9
  56. if r81 gt 0 :m
  57. :7
  58. mess opening width (greater than 0)
  59. c9=c1;getrd r9;if r9 le 0 :7;c1='w';ovl $rub;c1=c9
  60. :m
  61. mess height of opening (0 or greater)
  62. getrd r8;if r8 lt 0 :m;if r4 eq 1 :6;r8=(-r8)
  63. :6
  64. mess height above floor (0 or greater)
  65. getrd r7;if r7 lt 0 :6
  66. :9
  67. r10=0;i7=0;i8=0
  68. mess opening position (Alt+1-change opening orientation,2-origin)
  69. r3=30.
  70. c1='r'
  71. trace $rub p1
  72. c1='1';ovl $rub
  73. :A
  74. if r2 eq 0 :C;r10=1;if r2 eq 99 :E;r10=2
  75. :E
  76. r2=0
  77. :C
  78. c1='c';ovl cut
  79. if r2 eq 0 :B
  80. mess Error, opening is BEYOND the wall, or OVERLAPS another!
  81. getwe;c1='r';goto :s
  82. :B
  83. if r10 eq 0 :b
  84. c1='1';c2=' ';ovl opncon
  85. if r1 ne 0 :z
  86. if r10 eq 2 :b
  87. mess solution acceptable?
  88. getyn r2;if r2 eq 0 :D
  89. c1='u';ovl $rub
  90. i4=0;goto :b
  91. :D
  92. c1='e';ovl $wfix
  93. if r1 ne 0 :z
  94. i4=1;c1='0';ovl $rub
  95. if r1 eq 0 :A
  96. if r1 ne 999 :y
  97. mess All options were introduced. wish to loop again?
  98. getyn r2;if r2 eq 0 :z;i4=2;c1='0';ovl $rub;i4=1;goto :A
  99. :b
  100. mess y-another position, n-another wall, <ENTER>-displacement
  101. getyn+ r1;if r93 ne 0 :Z;if r1 eq 0 :s;goto :9
  102. :Z
  103. i3=0
  104. mess start of displacement (fixed point in model)
  105. getp p1
  106. mess end of displacement (point on opening)
  107. rubber line;getp p2;rubber off;c1='?d';ovl cut
  108. :c
  109. mess displacement
  110. def fl r1;getrd r1;if r1 le 0 :c
  111. c1='m';ovl cut
  112. if r2 ne 0 :g;r5=r1
  113. :i
  114. if i3 ne 0 :h
  115. c1='r';ovl $wfix
  116. if r1 ne 0 :f;i9=i1;i1=i2;command refe;i1=i9;r1=r5
  117. repeat :b
  118. :h
  119. i8=i4;ovl updcon
  120. if r1 ne 0 :f
  121. c1='r';ovl $wfix
  122. if r1 ne 0 :f;i9=i1;i1=i3;command refe
  123. if i8 eq 0 :H;i1=i8;command refe
  124. :H
  125. i1=i9;r1=r5;repeat :b
  126. :g
  127. mess Error, opening is BEYOND the wall, or OVERLAPS another!
  128. getwe;repeat :c
  129. :l
  130. mess arc wall was indicated, please try again:
  131. getwe;goto :j
  132. :t
  133. mess Error, illegal operation
  134. getwe;goto :z
  135. :w
  136. mess Error, change to non-orthogonal mode.
  137. getwe;goto :s
  138. :y
  139. mess Error, opening or library was NOT found
  140. getwe
  141. :z
  142.