daily pastebin goal
17%
SHARE
TWEET

Untitled

a guest Dec 14th, 2017 58 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Dim ka As Double
  2. Dim z As Double
  3. Dim x As Double
  4. Dim y As Double
  5. Dim fi(0 To 128) As Double
  6. Dim pi As Double
  7. Dim ro(0 To 128) As Double
  8. Dim linija As AcadLine
  9. Dim t1(0 To 2) As Double
  10. Dim t2(0 To 2) As Double
  11. Dim t3(0 To 2) As Double
  12. Dim i As Integer
  13. Dim j As Integer
  14. Dim xyz(0 To 128, 0 To 3, 1 To 3) As Double
  15.  
  16. Private Sub CommandButton1_Click()
  17. Me.Hide
  18. pi = 3.14159
  19. 'asis
  20. t1(0) = 0
  21. t1(1) = 0
  22. t1(2) = 0
  23.  
  24. t1(0) = 0
  25. t1(1) = 0
  26. t1(2) = 25
  27.  
  28. Set linija = ThisDrawing.ModelSpace.AddLine(t1, t2)
  29. linija.Layer = "aa"
  30.  
  31. For i = 0 To 128
  32. fi(i) = i * pi / 16
  33. Next i
  34.  
  35. z = 1 / 120 'kugis
  36.  
  37. ka = Sin(40 * pi / 180) / Tan(80 * pi / 180)
  38. MsgBox ka
  39.  
  40. For i = 0 To 128
  41. ro(i) = Exp(ka * fi(i)) 'kugis
  42. t2(0) = ro(i) * Cos(fi(i))
  43. t2(1) = ro(i) * Sin(fi(i))
  44. t2(2) = ro(i) / Tan(40 * pi / 180) 'kugis
  45.  
  46. 'taskas ant z-asies
  47.  
  48. t3(0) = 0
  49. t3(1) = 0
  50. t3(2) = t2(2)
  51. Set linija = ThisDrawing.ModelSpace.AddLine(t3, t2)
  52. linija.Layer = "aa"
  53.  
  54. Set linija = ThisDrawing.ModelSpace.AddLine(t1, t2)
  55. linija.Layer = "kk"
  56. linija.Update
  57.  
  58. 'uzpildome masyva
  59. x = (t3(0) - t2(0)) * 0.25
  60. y = (t3(1) - t2(1)) * 0.25
  61.  
  62. For j = 0 To 3
  63. xyz(i, j, 1) = t2(0) + x * j
  64. xyz(i, j, 2) = t2(1) + y * j
  65. xyz(i, j, 3) = t2(2)
  66. Next j
  67.  
  68. t1(0) = t2(0)
  69. t1(1) = t2(1)
  70. t1(2) = t2(2)
  71. Next i
  72.  
  73. 'Vidinis tinklas
  74.  
  75. For j = 0 To 3
  76. For i = 0 To 127
  77. t1(0) = xyz(i, j, 1)
  78. t1(1) = xyz(i, j, 2)
  79. t1(2) = xyz(i, j, 3)
  80. t2(0) = xyz(i + 1, j, 1)
  81. t2(1) = xyz(i + 1, j, 2)
  82. t2(2) = xyz(i + 1, j, 3)
  83.  
  84. Set linija = ThisDrawing.ModelSpace.AddLine(t1, t2)
  85. linija.Layer = "nn"
  86. linija.Update
  87. Next i
  88. Next j
  89.  
  90. Me.show
  91.  
  92. End Sub
  93.  
  94.  
  95. Private Sub CommandButton2_Click()
  96. Dim ka As Double
  97. Dim z As Double
  98. Dim x As Double
  99. Dim y As Double
  100. Dim fi(0 To 128) As Double
  101. Dim pi As Double
  102. Dim ro(0 To 128) As Double
  103. Dim linija As AcadLine
  104. Dim t1(0 To 2) As Double
  105. Dim t2(0 To 2) As Double
  106. Dim t3(0 To 2) As Double
  107. Dim i As Integer
  108. Dim j As Integer
  109. Dim xyz(0 To 128, 0 To 3, 1 To 3) As Double
  110.  
  111. Me.Hide
  112. pi = 3.14159
  113. 'asis
  114. t1(0) = 0
  115. t1(1) = 0
  116. t1(2) = 0
  117. t2(0) = 0
  118. t2(1) = 0
  119. t2(2) = 25
  120. Set linija = ThisDrawing.ModelSpace.AddLine(t1, t2)
  121. linija.Layer = "aa"
  122.  
  123. For i = 0 To 128
  124. fi(i) = i * pi / 16
  125. Next i
  126.  
  127. z = 15 / 120 'cilindras
  128.  
  129.  
  130. ka = Sin(40 * pi / 180) / Tan(80 * pi / 180)
  131. MsgBox ka
  132.  
  133. For i = 0 To 128
  134. ro(i) = 1
  135. t2(0) = ro(i) * Cos(fi(i))
  136. t2(1) = ro(i) * Sin(fi(i))
  137. t2(2) = z * i
  138.  
  139.  
  140. 'taskas ant z-asies
  141. t3(0) = 0
  142. t3(1) = 0
  143. t3(2) = t2(2)
  144. Set linija = ThisDrawing.ModelSpace.AddLine(t3, t2)
  145. linija.Layer = "aa"
  146.  
  147. Set linija = ThisDrawing.ModelSpace.AddLine(t1, t2)
  148. linija.Layer = "kk"
  149. linija.Update
  150.  
  151. 'uzpildome masyva
  152. x = (t3(0) - t2(0)) * 0.25
  153. y = (t3(1) - t2(1)) * 0.25
  154.  
  155. For j = 0 To 3
  156. xyz(i, j, 1) = t2(0) + x * j
  157. xyz(i, j, 2) = t2(1) + y * j
  158. xyz(i, j, 3) = t2(2)
  159.  
  160. Next j
  161.  
  162. t1(0) = t2(0)
  163. t1(1) = t2(1)
  164. t1(2) = t2(2)
  165.  
  166. Next i
  167.  
  168. 'Vidinis tinklas
  169. For j = 0 To 3
  170. For i = 0 To 127
  171. t1(0) = xyz(i, j, 1)
  172. t1(1) = xyz(i, j, 2)
  173. t1(2) = xyz(i, j, 3)
  174. t2(0) = xyz(i + 1, j, 1)
  175. t2(1) = xyz(i + 1, j, 2)
  176. t2(2) = xyz(i + 1, j, 3)
  177.  
  178. Set linija = ThisDrawing.ModelSpace.AddLine(t1, t2)
  179. linija.Layer = "nn"
  180. linija.Update
  181.  
  182. Next i
  183. Next j
  184.  
  185.  
  186.  
  187.  
  188. Me.show
  189.  
  190. End Sub
  191.  
  192.  
  193. Private Sub CommandButton3_Click()
  194. Dim ka As Double
  195. Dim z As Double
  196. Dim x As Double
  197. Dim y As Double
  198. Dim fi(0 To 128) As Double
  199. Dim pi As Double
  200. Dim ro(0 To 128) As Double
  201. Dim linija As AcadLine
  202. Dim t1(0 To 2) As Double
  203. Dim t2(0 To 2) As Double
  204. Dim t3(0 To 2) As Double
  205. Dim i As Integer
  206. Dim j As Integer
  207. Dim xyz(0 To 128, 0 To 3, 1 To 3) As Double
  208.  
  209. Me.Hide
  210. pi = 4
  211. 'asis
  212. t1(0) = 0
  213. t1(1) = 0
  214. t1(2) = 0
  215. t2(0) = 0
  216. t2(1) = 0
  217. t2(2) = 25
  218. Set linija = ThisDrawing.ModelSpace.AddLine(t1, t2)
  219. linija.Layer = "aa"
  220.  
  221. For i = 0 To 128
  222. fi(i) = i * pi / 20
  223. Next i
  224.  
  225. z = 15 / 50 'cilindras
  226.  
  227.  
  228. ka = Cos(40 * pi / 180 / 2) / Sin(80 * pi / 180)
  229. MsgBox ka
  230.  
  231. For i = 0 To 128
  232. ro(i) = 1
  233. t2(0) = ro(i) * Tan(fi(i))
  234. t2(1) = ro(i) * Sin(fi(i))
  235. t2(2) = z * i
  236.  
  237.  
  238. 'taskas ant z-asies
  239. t3(0) = 0
  240. t3(1) = 0
  241. t3(2) = t2(2)
  242. Set linija = ThisDrawing.ModelSpace.AddLine(t3, t2)
  243. linija.Layer = "aa"
  244.  
  245. t4(0) = 0
  246. t4(1) = 0
  247. t4(2) = t2(2) - z
  248.  
  249. t5(0) = t2(0)
  250. t5(1) = t2(1)
  251. t5(2) = t2(2) - z
  252. Set linija = ThisDrawing.ModelSpace.AddLine(t4, t5)
  253. linija.Layer = "laip"
  254.  
  255. Set linija = ThisDrawing.ModelSpace.AddLine(t1, t2)
  256. linija.Layer = "kk"
  257. linija.Update
  258.  
  259. 'uzpildome masyva
  260. x = (t3(0) - t2(0)) * 0.9
  261. y = (t3(1) - t2(1)) * 0.8
  262.  
  263. For j = 0 To 3
  264. xyz(i, j, 1) = t2(0) + x * j
  265. xyz(i, j, 2) = t2(1) + y * j
  266. xyz(i, j, 3) = t2(2)
  267.  
  268. Next j
  269.  
  270. t1(0) = t2(0)
  271. t1(1) = t2(1)
  272. t1(2) = t2(2)
  273.  
  274. Next i
  275.  
  276. 'Vidinis tinklas
  277. For j = 0 To 3
  278. For i = 0 To 127
  279. t1(0) = xyz(i, j, 1)
  280. t1(1) = xyz(i, j, 2)
  281. t1(2) = xyz(i, j, 3)
  282. t2(0) = xyz(i + 1, j, 1)
  283. t2(1) = xyz(i + 1, j, 2)
  284. t2(2) = xyz(i + 1, j, 3)
  285.  
  286. Set linija = ThisDrawing.ModelSpace.AddLine(t1, t2)
  287. linija.Layer = "nn"
  288. linija.Update
  289.  
  290. Next i
  291. Next j
  292.  
  293. Me.show
  294. End Sub
RAW Paste Data
Top