home *** CD-ROM | disk | FTP | other *** search
/ Antennas / Antennas_CD-ROM_Walnut_Creek_September_1996.iso / mininec / mn3basic / mnarray.asc < prev    next >
Text File  |  1996-06-30  |  5KB  |  169 lines
  1. 2 ON ERROR GOTO 60000
  2. 10 PRINT"      ************************************************"
  3. 20 PRINT"      *      PROGRAM TO ASSEMBLE MININEC ARRAYS      *"
  4. 30 PRINT"      *      FROM MININEC ELEMENTS CREATED WITH      *"
  5. 40 PRINT"      *             MININEC OR MNGEOM                *"
  6. 50 PRINT"      *            R.P. HAVILAND, W4MB               *"
  7. 60 PRINT"      *          PROGRAM  COPYRIGHT 1990             *"
  8. 70 PRINT"      *              MINILAB BOOKS                   *"
  9. 80 PRINT"      *        DAYTONA BEACH, FL 32121-1086          *"
  10. 90 PRINT"      ************************************************"
  11. 100 PRINT :PRINT  "THIS PROGRAM ASSEMBLES AN ARRAY FROM MININEC FILE ELEMENTS"
  12. 110 PRINT  " AND ALLOWS GEOMETRY AND WIRE SIZE TO BE CHANGED"
  13. 120 PRINT :INPUT "SEE FILE DIRECTORY, Y/N"; T$
  14. 130 IF T$<>"Y" THEN 500
  15. 140 INPUT "ENTER FILEPATH TO USE, INCLUDE : AND /"; FP$
  16. 150 PRINT :PRINT "PRESS RETURN TO CLEAR LISTING"
  17. 160 FILES FP$
  18. 170 INPUT T$
  19. 500 CLS
  20. 510 INPUT " ENTER NUMBER OF ELEMENTS IN ASSEMBLED ARRAY";NEL
  21. 520 DIM A(50,8)
  22. 530 TNW=0
  23. 540 FOR I=1 TO NEL
  24. 550 GOSUB 4000 'GET ELEMENT DATA
  25. 560 GOSUB 5000 'RESIZE ELEMENT
  26. 570 GOSUB 6000 'MOVE ELEMENT DATA
  27. 580 GOSUB 7000 'CHANGE WIRE RADIUS
  28. 590 NEXT I
  29. 600 GOSUB 8000 'SAVE ARRAY DATA
  30. 900 STOP
  31. 3999 REM GET ELEMENT DATA
  32. 4000 PRINT  " FOR ELEMENT NO. ";I
  33. 4010 INPUT "NAME OF ELEMENT TO USE: .GEO WILL BE ADDED";NE$
  34. 4020 INPUT "FILEPATH TO USE, INCLUDE : AND /";FP$
  35. 4030 NF$=FP$+NE$+".GEO"
  36. 4100 OPEN NF$ AS #1 LEN=30
  37. 4110 FIELD #1,2 AS S$,4 AS X1$,4 AS Y1$,4 AS Z1$,4 AS X2$,4 AS Y2$,4 AS Z2$,4 AS R$ 
  38. 4120 GET #1
  39. 4130 NW(I)=CVI(S$)
  40. 4140 TNW=TNW + NW(I)
  41. 4150 IF TNW > 50 THEN PRINT "***** BEYOND 50 WIRES: STANDARD MININEC CAN'T ANAYLIZE *****" :STOP
  42. 4160 PRINT "   ELEMENT # ";I
  43. 4200 FOR J=TNW-NW(I)+1 TO TNW
  44. 4210 GET #1
  45. 4220 A(J,1)=CVI(S$)
  46. 4230 A(J,2)=CVS(X1$)
  47. 4240 A(J,3)=CVS(Y1$)
  48. 4250 A(J,4)=CVS(Z1$)
  49. 4260 A(J,5)=CVS(X2$)
  50. 4270 A(J,6)=CVS(Y2$)
  51. 4280 A(J,7)=CVS(Z2$)
  52. 4290 A(J,8)=CVS(R$)
  53. 4300 PRINT "SEGMENT ";J;
  54. 4310 FOR K=1 TO 8
  55. 4320 PRINT A (J,K);"   ";
  56. 4330 NEXT K
  57. 4340 PRINT 
  58. 4400 NEXT J
  59. 4500 CLOSE 1
  60. 4600 RETURN    
  61. 4999 REM RESIZE ELEMENT
  62. 5000 PRINT :PRINT "RE-SIZE ELEMENT #";I;", Y/N"
  63. 5010 INPUT T$
  64. 5120 IF T$<>"Y" THEN 6900
  65. 5130 PRINT :PRINT " ELEMENT # ";I;" POSITION IS"
  66. 5140 PRINT "X1     Y1     Z1      X2     Y2      Z2"
  67. 5150 FOR J=TNW-NW(I)+1 TO TNW
  68. 5160 FOR K=2 TO 7
  69. 5170 PRINT  A(J,K);"     ";
  70. 5180 NEXT K
  71. 5190 PRINT 
  72. 5200 NEXT J
  73. 5400 INPUT " ENTER ELEMENT RESIZE SCALE FACTORS FOR X,Y,Z, 1=NO CHANGE ";SX,SY,SZ
  74. 5410 FOR J=TNW-NW(I)+1 TO TNW
  75. 5420 A(J,2)=A(J,2)*SX
  76. 5430 A(J,3)=A(J,3)*SY
  77. 5440 A(J,4)=A(J,4)*SZ
  78. 5450 A(J,5)=A(J,5)*SX
  79. 5460 A(J,6)=A(J,6)*SY
  80. 5470 A(J,7)=A(J,7)*SZ
  81. 5500 NEXT J
  82. 5600 PRINT :PRINT " ELEMENT # ";I;" NEW SIZE IS"
  83. 5610 PRINT "X1     Y1     Z1      X2     Y2      Z2"
  84. 5620 FOR J=TNW-NW(I)+1 TO TNW
  85. 5630 FOR K=2 TO 7
  86. 5640 PRINT  A(J,K);"    ";
  87. 5650 NEXT K
  88. 5660 PRINT 
  89. 5670 NEXT J
  90. 5900 RETURN
  91. 5999 REM RELOCATE ELEMENT
  92. 6000 PRINT :PRINT "RELOCATE ELEMENT #";I;", Y/N"
  93. 6010 INPUT T$
  94. 6120 IF T$<>"Y" THEN 6900
  95. 6130 PRINT :PRINT " ELEMENT # ";I;" POSITION IS"
  96. 6140 PRINT "X1     Y1     Z1      X2     Y2      Z2"
  97. 6150 FOR J=TNW-NW(I)+1 TO TNW
  98. 6160 FOR K=2 TO 7
  99. 6170 PRINT  A(J,K);"     ";
  100. 6180 NEXT K
  101. 6190 PRINT 
  102. 6200 NEXT J
  103. 6400 INPUT " ENTER DISTANCE TO MOVE ELEMENT, X,Y,Z ";MX,MY,MZ
  104. 6410 FOR J=TNW-NW(I)+1 TO TNW
  105. 6420 A(J,2)=A(J,2)+MX
  106. 6430 A(J,3)=A(J,3)+MY
  107. 6440 A(J,4)=A(J,4)+MZ
  108. 6450 A(J,5)=A(J,5)+MX
  109. 6460 A(J,6)=A(J,6)+MY
  110. 6470 A(J,7)=A(J,7)+MZ
  111. 6500 NEXT J
  112. 6600 PRINT :PRINT " ELEMENT # ";I;" NEW POSITION IS"
  113. 6610 PRINT "X1     Y1     Z1      X2     Y2      Z2"
  114. 6620 FOR J=TNW-NW(I)+1 TO TNW
  115. 6630 FOR K=2 TO 7
  116. 6640 PRINT  A(J,K);"    ";
  117. 6650 NEXT K
  118. 6660 PRINT 
  119. 6670 NEXT J
  120. 6900 RETURN
  121. 6999 REM CHANGE WIRE RADIUS
  122. 7000 PRINT :INPUT "CHANGE WIRE RADIUS,Y/N";T$
  123. 7010 IF T$<>"Y" THEN 7900
  124. 7020 PRINT  "WIRE DIAMETERS ARE"
  125. 7030 FOR  J=TNW-NW(I)+1 TO TNW
  126. 7040 PRINT A(J,8)
  127. 7050 NEXT J
  128. 7060 INPUT "ENTER NEW WIRE RADIUS, ALL WIRES IN ELEMENT"; NWR
  129. 7070 FOR  J=TNW-NW(I)+1 TO TNW
  130. 7080 A(J,8)=NWR
  131. 7090 NEXT J
  132. 7900 RETURN
  133. 7999 REM SAVE NEW ARRAY
  134. 8000 PRINT :INPUT " NAME OF NEW ARRAY, .GEO WILL BE ADDED";NA$
  135. 8010 INPUT "FILEPATH FOR SAVE, INCLUDE : AND /"; FP$
  136. 8020 NS$=FP$+NA$+".GEO"
  137. 8030 OPEN  NS$ AS #1 LEN=30
  138. 8040 FIELD #1,2 AS S$,4 AS X1$,4 AS Y1$,4 AS Z1$,4 AS X2$,4 AS Y2$,4 AS Z2$,4 AS RW$    
  139. 8050 A(0,1)=TNW
  140. 8060 REM NOW SEND NEW FILE TOTAL NO WIRES FIRST
  141. 8070 FOR I=0 TO TNW
  142. 8080 LSET S$=MKI$(A(I,1))
  143. 8090 LSET X1$=MKS$(A(I,2))
  144. 8100 LSET Y1$=MKS$(A(I,3))
  145. 8110 LSET Z1$=MKS$(A(I,4))
  146. 8120 LSET X2$=MKS$(A(I,5))
  147. 8130 LSET Y2$=MKS$(A(I,6))
  148. 8140 LSET Z2$=MKS$(A(I,7))
  149. 8150 LSET RW$=MKS$(A(I,8))
  150. 8160 PUT #1
  151. 8180 NEXT I
  152. 8190 CLOSE 1
  153. 8900 RETURN
  154. 9999 END 
  155. 60000 PRINT  "ERROR ";ERR;" AT LINE ";ERL
  156. 60010 IF ERL=160 THEN RESUME 120
  157. 60020 IF ERL=4100 THEN RESUME 4000
  158. 60030 IF ERL=8030 THEN RESUME 8000
  159.  
  160.  
  161.  
  162.  
  163.  
  164.  
  165.  
  166.  
  167.  
  168.  
  169.