Makro AutoCad-a rysujące kątowniki

Autor podstrony: Krzysztof Zajączkowski

Stronę tą wyświetlono już: 3634 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ą:

Sub MKatownik() Dim R(2) As Double R(0) = InputBox("Podaj wartość promienia pierwszego ramienia kątownika:", "Promień", 5, 1000, 1000, "", 0) R(1) = InputBox("Podaj wartość promienia drugiego ramienia kątownika:", "Promień", 5, 1000, 1000, "", 0) R(2) = InputBox("Podaj wartość promienia wewnętrznego kątownika:", "Promień", 5, 1000, 1000, "", 0) 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) End Sub 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) Dim c(5) As AcadEntity Dim XYZ(8) As Double XYZ(0) = X: XYZ(1) = Y: XYZ(2) = Z XYZ(3) = X: XYZ(4) = l1 + Y: XYZ(5) = Z XYZ(6) = l2 + X: XYZ(7) = l1 + Y: XYZ(8) = Z Set c(0) = ThisDrawing.ModelSpace.Add3DPoly(XYZ) Dim XYZ2(2) As Double XYZ2(0) = X: XYZ2(1) = R(0) + Y: XYZ2(2) = Z Dim PI As Double, StartAngle As Double, EndAngle As Double PI = 3.141592654 StartAngle = 270 * PI / 180 EndAngle = -Atn(Zbieznosc1) Set c(1) = ThisDrawing.ModelSpace.AddArc(XYZ2, R(0), StartAngle, EndAngle) XYZ2(0) = l2 - R(1) + X: XYZ2(1) = l1 + Y: XYZ2(2) = Z StartAngle = 3 * PI / 2 + Atn(Zbieznosc2) EndAngle = 0 Set c(2) = ThisDrawing.ModelSpace.AddArc(XYZ2, R(1), StartAngle, EndAngle) 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 Poczatek1(0) = R(0) * Cos(Atn(Zbieznosc1)) + X: Poczatek1(1) = R(0) - R(0) * Sin(Atn(Zbieznosc1)) + Y: Poczatek1(2) = Z Poczatek2(0) = l2 - R(1) + R(1) * Sin(Atn(Zbieznosc2)) + X: Poczatek2(1) = l1 - R(1) * Cos(Atn(Zbieznosc2)) + Y: Poczatek2(2) = Z Wyznacznik = Cos(Atn(Zbieznosc1)) * Cos(Atn(Zbieznosc2)) - Sin(Atn(Zbieznosc2)) * Sin(Atn(Zbieznosc1)) Beta(0) = PI / 2 - Atn(Zbieznosc1) - Atn(Zbieznosc2) Beta(1) = PI - Beta(0) L(2) = ((2 * R(2) ^ 2 - 2 * R(2) ^ 2 * Cos(Beta(0))) / (2 - 2 * Cos(Beta(1)))) ^ 0.5 L(0) = ((Poczatek2(1) - Poczatek1(1)) * Cos(Atn(Zbieznosc2)) - (Poczatek2(0) - Poczatek1(0)) * Sin(Atn(Zbieznosc2))) / Wyznacznik - L(2) L(1) = ((Poczatek2(0) - Poczatek1(0)) * Cos(Atn(Zbieznosc1)) - Sin(Atn(Zbieznosc1)) * (Poczatek2(1) - Poczatek1(1))) / Wyznacznik - L(2) Koniec1(0) = Poczatek1(0) + L(0) * Sin(Atn(Zbieznosc1)): Koniec1(1) = Poczatek1(1) + L(0) * Cos(Atn(Zbieznosc1)): Koniec1(2) = Z Koniec2(0) = Poczatek2(0) - L(1) * Cos(Atn(Zbieznosc2)): Koniec2(1) = Poczatek2(1) - L(1) * Sin(Atn(Zbieznosc2)): Koniec2(2) = Z Set c(3) = ThisDrawing.ModelSpace.AddLine(Poczatek1, Koniec1) Set c(4) = ThisDrawing.ModelSpace.AddLine(Poczatek2, Koniec2) XYZ2(0) = Koniec1(0) + R(2) * Cos(Atn(Zbieznosc1)): XYZ2(1) = Koniec1(1) - R(2) * Sin(Atn(Zbieznosc1)): XYZ2(2) = Z StartAngle = PI - Atn(Zbieznosc1) - Beta(0): EndAngle = PI - Atn(Zbieznosc1) Set c(5) = ThisDrawing.ModelSpace.AddArc(XYZ2, R(2), StartAngle, EndAngle) Dim Powierzchnia As Variant Powierzchnia = ThisDrawing.ModelSpace.AddRegion(c) Dim solidObj As Acad3DSolid Set solidObj = ThisDrawing.ModelSpace.AddExtrudedSolid(Powierzchnia(0), Dlugosc, 0) For i = 0 To 5 c(i).Delete Next i End Function
Propozycje książek