[VBA] Pręt zbrojeniowy


Recommended Posts

Witam serdecznie, po moich pytaniach zostało mi wypomniany kod spaghetti. Chciałbym go poprawić.

Prosiłbym o wsparcie przy napisaniu kodu, który będzie tworzył pręt zbrojeniowy. W kolejnych postach (po rozwiązaniu aktualnego problemu) będę dopytywać o kolejne operacje, jak opisywanie długości odcinków, zaokrąglanie.

Przykład aktualnie użytego kodu:

Private Sub cmdTest_Click()
frm_test.Hide
Dim NAROZNIK As Variant
Dim p() As Double
NAROZNIK = ThisDrawing.Utility.GetPoint(, "Podaj punkt początkowy:")

ReDim p(7) As Double
p(0) = NAROZNIK(0): p(1) = NAROZNIK(1)
p(2) = NAROZNIK(0) + 50: p(3) = NAROZNIK(1) + 30
p(4) = NAROZNIK(0) + 100: p(5) = NAROZNIK(1) + 30
p(6) = NAROZNIK(0) + 100: p(7) = NAROZNIK(1)

Set ZcadPolyline = ThisDrawing.ModelSpace.AddLightWeightPolyline(p)
ZcadPolyline.ConstantWidth = 1
End Sub

Coś tam czytałem o kolekcjach, chciałbym przerobić ten kod tworząc kolekcję, a punkty kolejne p(0), p(1)... dodawać kolejno jako kolekcja.Add, chodzi mi o coś takiego:

Private Sub cmdTest_Click()
frm_test.Hide
Dim NAROZNIK As Variant
Dim p(1) As Double
NAROZNIK = ThisDrawing.Utility.GetPoint(, "Podaj punkt początkowy:")

Stwórz nową kolekcję o nazwie pret
p(0) = NAROZNIK(0): p(1) = NAROZNIK(1)
pret.Add (p(0) i p(1))

//tutaj jakiś kod z obliczeniami kolejnych punktów oraz podmienieniem punktów p(0) i p(1)
pret.Add (p(0) i p(1))

//tutaj kolejny kod z obliczeniami kolejnych punktów oraz podmienieniem punktów p(0) i p(1)
pret.Add (p(0) i p(1))

//finalnie mam kolekcje punktów zapisany w pret(0), pret(1), pret(2) itd..

Set ZcadPolyline = ThisDrawing.ModelSpace.AddLightWeightPolyline(kolekcja pret)
ZcadPolyline.ConstantWidth = 1

wyczyść kolekcję pret aby móc jej użyć ponownie dla innego pręta

End Sub

Zmiana tablic na kolekcję mam mi ułatwić dodawanie kolejnych punktów, a także operację na nich o czym napiszę w kolejnych postach. Przy operacjach na nich będę dokładał w środek kolekcji kolejne punkty (tak to sobie wymyśliłem, czy poprawnie, to się okaże)

Pozdrawiam

Link to comment
Share on other sites

Spróbowałem swoich sił na przykładzie kodu w Internecie. Najpierw dodałem Klasę w module o nazwie "Punkt" z kodem:

Public X As Double
Public Y As Double

A swój kod zmodyfikowałem:

Private Sub cmdTest_Click()
frm_testmoj.Hide
Dim NAROZNIK As Variant
Dim p() As Double
NAROZNIK = ThisDrawing.Utility.GetPoint(, "Podaj punkt początkowy:")

Dim kolekcjaPunktow As Collection
Set kolekcjaPunktow = New Collection

Dim pretPunkt As Punkt

Set pretPunkt = New Punkt
pretPunkt.X = NAROZNIK(0)
pretPunkt.Y = NAROZNIK(1)
kolekcjaPunktow.Add pretPunkt
Set pretPunkt = Nothing

Set pretPunkt = New Punkt
pretPunkt.X = NAROZNIK(0) + 50
pretPunkt.Y = NAROZNIK(1) + 30
kolekcjaPunktow.Add pretPunkt
Set pretPunkt = Nothing

Set pretPunkt = New Punkt
pretPunkt.X = NAROZNIK(0) + 100
pretPunkt.Y = NAROZNIK(1) + 30
kolekcjaPunktow.Add pretPunkt
Set pretPunkt = Nothing

Set pretPunkt = New Punkt
pretPunkt.X = NAROZNIK(0) + 100
pretPunkt.Y = NAROZNIK(1)
kolekcjaPunktow.Add pretPunkt
Set pretPunkt = Nothing


Set ZcadPolyline = ThisDrawing.ModelSpace.AddLightWeightPolyline(KolekcjaDoTablicy(kolekcjaPunktow))
ZcadPolyline.ConstantWidth = 1

'Zwalniamy zmienną obiektową

Set kolekcjaPunktow = Nothing
End Sub

w międzyczasie zauważyłem, że nie ma jak użyć kolekcji do rysowania polilinii, więc przygotowałem funkcję KolekcjaDoTablicy

Function KolekcjaDoTablicy(Punkty As Collection) As Variant
Dim i, j, ilosc As Integer
Dim Tablica() As Double

ilosc = Punkty.count * 2
ReDim Tablica(ilosc)

j = 0
For i = 0 To Punkty.count - 1
    Tablica(j) = Punkty(i + 1).X
    Tablica(j + 1) = Punkty(i + 1).Y
    j = j + 2
Next i

KolekcjaDoTablicy = Tablica
End Function

Ale nie działa 😞

Run-time error '-2145320943 (80210011)'.

przy kodzie:

Set ZcadPolyline = ThisDrawing.ModelSpace.AddLightWeightPolyline(KolekcjaDoTablicy(kolekcjaPunktow))

Można jakąś podpowiedź?

Edited by pop3k
Link to comment
Share on other sites

A na drugi, to ten kod z tablicami dla mnie był bardziej czytelny niż z kolekcjami.

Refaktoryzacja w celu usunięcia kodu spagetti przez wydzielenie funkcji to dobry plan. Ale zmiana typy danych z tablicy na kolekcję, to po żeby za chwilę zmieniać kolekcję na tablicę to ma skutek dokładnie odwrotny.

Myślę, że lepszym planem byłoby oddzielenie operacji typu interakcja z użytkownikiem, przeliczenie punktów rysowanie. np tak

Public Function ZapytajOPunkt(komunikat As String)
    ZapytajOPunkt = ThisDrawing.Utility.GetPoint(, komunikat)
End Function

Public Function przeliczPunkty(NAROZNIK As Variant)
	ReDim p(7) As Double
	p(0) = NAROZNIK(0): p(1) = NAROZNIK(1)
	p(2) = NAROZNIK(0) + 50: p(3) = NAROZNIK(1) + 30
	p(4) = NAROZNIK(0) + 100: p(5) = NAROZNIK(1) + 30
	p(6) = NAROZNIK(0) + 100: p(7) = NAROZNIK(1)
	przeliczPunkty = p
End Function

Public Function rysuj(p)
    Dim poly As ZcadLWPolyline
    Set poly = ThisDrawing.ModelSpace.AddLightWeightPolyline(p)
    poly.ConstantWidth = 1
End Function


Private Sub Test()
' frm_test.Hide

    Dim NAROZNIK As Variant
    NAROZNIK = ZapytajOPunkt("Podaj punkt początkowy:")

    Dim p() As Double
    p = przeliczPunkty(NAROZNIK)

    rysuj (p)

End Sub

Dzięki temu

  • pracujesz szybciej, bo jesteś niezależny od okna
  • możesz w innej funkcji testującej wywołać np tylko rysuj(p) na danych sztucznie spreparowanych dzięki czemu masz pewność że ten obszar DZIAŁA.
  • masz wszystkie operacje związane z reprezentacją grafiki w jednym miejscu. więc jeśli chcesz w innym miejscu aplikacji narysować podobną polilinię, to nie musisz pamiętać że masz jeszcze zmienić jej szerokość.
  • Jeśli chcesz zmienić polilinię, np na szerszą, albo podmienić na inny typ elementu np blok, robisz to tylko w jednym miejscu, w funkcji rysuj, a nie musisz szukać w innych miejscach aplikacji gdzie to jeszcze i po pozmieniać.
Link to comment
Share on other sites

Funkcja 

przeliczPunkty(NAROZNIK As Variant) 

nie ma sensu, bo każdy pręt będzie miał swoje współrzędne.

Ogólnie pomyślę o tym co napisałeś, dzięki za porady. Temat jeszcze nie jest zakończony, więc jeszcze się odezwę :)

 

Jeżeli chodzi o moj przykład z kolekcją... zamiana 

ZcadPolyline 

na

 

ZcadLWPolyline 

nie pomogła 😞

Edited by pop3k
Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Loading...
 Share