Makro AutoCad-a rysujące kątowniki

Stronę tą wyświetlono już: 523 razy

Dawno, dawno, dawno temu napisałem serię małych makr w VBA, które działały pod AutoCad-em. Niestety dostępu do tego programu już nie mam, aczkolwiek pozostały mi właśnie te makra napisane przeze mnie. Poniżej zamieszczam funkcję i makro, które umożliwiają automatyczne wygenerowanie kątownika o określonych wymiarach.

Profil kątownika rysowanego przez makro
Rys. 1
Profil kątownika rysowanego przez makro i funkcję VBA.

Opis oznaczeń:

  • L1, L2 - długości ramion kątownika;
  • R1, R2, R3 - promienie zaokrąglenia kątownika;
  • Z1, Z2 - zbieżności ramion kątownika.

Sam kod skryptu VBA ma postać następującą:

Listing 1
  1. Sub MKatownik()
  2. Dim R(2) As Double
  3. R(0) = InputBox("Podaj wartość promienia pierwszego ramienia kątownika:", "Promień", 5, 1000, 1000, "", 0)
  4. R(1) = InputBox("Podaj wartość promienia drugiego ramienia kątownika:", "Promień", 5, 1000, 1000, "", 0)
  5. R(2) = InputBox("Podaj wartość promienia wewnętrznego kątownika:", "Promień", 5, 1000, 1000, "", 0)
  6. Katownik InputBox("Podaj długość pierwszego ramienia kątownika: ", "Długość 1", 40, 1000, 1000, "", 0), InputBox("Podaj długość drugiego ramienia kątownika: ", "Długość 2", 40, 1000, 1000, "", 0), R, InputBox("Podaj wartość zbieżności pierwszego ramienia kątownika: ", "Zbieznosc 1", 0.05, 1000, 1000, "", 0), InputBox("Podaj wartość zbieżności drugiego ramienia kątownika: ", "Zbieznosc 2", 0.05, 1000, 1000, "", 0), InputBox("Podaj położenie względem osi X: ", "X", 0, 1000, 1000, "", 0), InputBox("Podaj położenie względem osi Y: ", "Y", 0, 1000, 1000, "", 0), InputBox("Podaj położenie względem osi Z: ", "Z", 0, 1000, 1000, "", 0), InputBox("Długość wyciągnięcia: ", "L", 100, 1000, 1000, "", 0)
  7. End Sub
  8. Function Katownik(l1 as Double, l2 as Double, R, Zbieznosc1 as Double, Zbieznosc2 as Double, X as Double, Y as Double, Z as Double, Dlugosc as Double)
  9. Dim c(5) As AcadEntity
  10. Dim XYZ(8) As Double
  11. XYZ(0) = X: XYZ(1) = Y: XYZ(2) = Z
  12. XYZ(3) = X: XYZ(4) = l1 + Y: XYZ(5) = Z
  13. XYZ(6) = l2 + X: XYZ(7) = l1 + Y: XYZ(8) = Z
  14. Set c(0) = ThisDrawing.ModelSpace.Add3DPoly(XYZ)
  15. Dim XYZ2(2) As Double
  16. XYZ2(0) = X: XYZ2(1) = R(0) + Y: XYZ2(2) = Z
  17. Dim PI as Double, StartAngle as Double, EndAngle as Double
  18. PI = 3.141592654
  19. StartAngle = 270 * PI / 180
  20. EndAngle = -Atn(Zbieznosc1)
  21. Set c(1) = ThisDrawing.ModelSpace.AddArc(XYZ2, R(0), StartAngle, EndAngle)
  22. XYZ2(0) = l2 - R(1) + X: XYZ2(1) = l1 + Y: XYZ2(2) = Z
  23. StartAngle = 3 * PI / 2 + Atn(Zbieznosc2)
  24. EndAngle = 0
  25. Set c(2) = ThisDrawing.ModelSpace.AddArc(XYZ2, R(1), StartAngle, EndAngle)
  26. Dim Poczatek1(2) As Double, Koniec1(2) As Double, Poczatek2(2) As Double, Koniec2(2) As Double, L(2) As Double, Wyznacznik as Double, Beta(1) As Double
  27. Poczatek1(0) = R(0) * Cos(Atn(Zbieznosc1)) + X: Poczatek1(1) = R(0) - R(0) * Sin(Atn(Zbieznosc1)) + Y: Poczatek1(2) = Z
  28. Poczatek2(0) = l2 - R(1) + R(1) * Sin(Atn(Zbieznosc2)) + X: Poczatek2(1) = l1 - R(1) * Cos(Atn(Zbieznosc2)) + Y: Poczatek2(2) = Z
  29. Wyznacznik = Cos(Atn(Zbieznosc1)) * Cos(Atn(Zbieznosc2)) - Sin(Atn(Zbieznosc2)) * Sin(Atn(Zbieznosc1))
  30. Beta(0) = PI / 2 - Atn(Zbieznosc1) - Atn(Zbieznosc2)
  31. Beta(1) = PI - Beta(0)
  32. L(2) = ((2 * R(2) ^ 2 - 2 * R(2) ^ 2 * Cos(Beta(0))) / (2 - 2 * Cos(Beta(1)))) ^ 0.5
  33. L(0) = ((Poczatek2(1) - Poczatek1(1)) * Cos(Atn(Zbieznosc2)) - (Poczatek2(0) - Poczatek1(0)) * Sin(Atn(Zbieznosc2))) / Wyznacznik - L(2)
  34. L(1) = ((Poczatek2(0) - Poczatek1(0)) * Cos(Atn(Zbieznosc1)) - Sin(Atn(Zbieznosc1)) * (Poczatek2(1) - Poczatek1(1))) / Wyznacznik - L(2)
  35. Koniec1(0) = Poczatek1(0) + L(0) * Sin(Atn(Zbieznosc1)): Koniec1(1) = Poczatek1(1) + L(0) * Cos(Atn(Zbieznosc1)): Koniec1(2) = Z
  36. Koniec2(0) = Poczatek2(0) - L(1) * Cos(Atn(Zbieznosc2)): Koniec2(1) = Poczatek2(1) - L(1) * Sin(Atn(Zbieznosc2)): Koniec2(2) = Z
  37. Set c(3) = ThisDrawing.ModelSpace.AddLine(Poczatek1, Koniec1)
  38. Set c(4) = ThisDrawing.ModelSpace.AddLine(Poczatek2, Koniec2)
  39. XYZ2(0) = Koniec1(0) + R(2) * Cos(Atn(Zbieznosc1)): XYZ2(1) = Koniec1(1) - R(2) * Sin(Atn(Zbieznosc1)): XYZ2(2) = Z
  40. StartAngle = PI - Atn(Zbieznosc1) - Beta(0): EndAngle = PI - Atn(Zbieznosc1)
  41. Set c(5) = ThisDrawing.ModelSpace.AddArc(XYZ2, R(2), StartAngle, EndAngle)
  42. Dim Powierzchnia as Variant
  43. Powierzchnia = ThisDrawing.ModelSpace.AddRegion(c)
  44. Dim solidObj as Acad3DSolid
  45. Set solidObj = ThisDrawing.ModelSpace.AddExtrudedSolid(Powierzchnia(0), Dlugosc, 0)
  46. For i = 0 To 5
  47. c(i).Delete
  48. Next i
  49. End Function

Komentarze