[VBA] Grupuj


Rekomendowane odpowiedzi

Witam, kolejny problem, który bardzo ciężko wygooglować to tworzenie grup. Ogólnie używam podczas rysowania w ZWCad funkcji _GROUPUNNAME, który ma za zadanie ułatwić mi przesuwanie obiektów. Nie zależy mi więc na nazywaniu grup. Jak to zrobić w VBA?

Domyślam się, że trzeba by było zaznaczyć moje obiekty i wtedy wklepać funkcje grupowania. Mam taki przykładowy kod:

Private Sub b_draw_Click()

    frm_ZP.Hide
    
Dim PIERWSZY, DRUGI, TRZECI, CZWARTY As Variant
Dim Points(3) As Double
Dim Dlugosc As Integer
Dim FileToInsert As String
Dim punktyBlok(0 To 2) As Double
Dim pt1(0 To 2) As Double, pt2(0 To 2) As Double
Dim skala, skalajednostki As Double
    
Dim BlockRef As ZcadBlockReference
Dim BlockAttributes As Variant


PIERWSZY = ThisDrawing.Utility.GetPoint(, "Podaj punkt P1 (początek pręta):")
DRUGI = ThisDrawing.Utility.GetPoint(PIERWSZY, "Podaj punkt P2 (koniec pręta):")
TRZECI = ThisDrawing.Utility.GetPoint(, "Podaj punkt P3 (poczatek rozkładu:")
CZWARTY = ThisDrawing.Utility.GetPoint(TRZECI, "Podaj punkt P4 (koniec rozkładu):")
    


Set newlayer = ThisDrawing.Layers.Add("OPISY")
ThisDrawing.ActiveLayer = newlayer

  
'TWORZĘ LINIĘ PIONOWĄ
Points(0) = TRZECI(0)
Points(1) = Maximum(TRZECI(1), CZWARTY(1)) + Int(txt_xPyP.Value) / skalajednostki
Points(2) = Points(0)
Points(3) = Minimum(TRZECI(1), CZWARTY(1)) - Int(txt_xLyL.Value) / skalajednostki
 
Set ZcadPolyline = ThisDrawing.ModelSpace.AddLightWeightPolyline(Points)
 
  
  
'WSTAWIAM ZNACZNIK STRZAŁKI JAKO BLOK I PRZEKRĘCAM GO O 90st
punktyBlok(0) = Points(0): punktyBlok(1) = Points(1): punktyBlok(2) = 0
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  FileToInsert = "C:\BLOKI\STRZALKA.dwg"
  pt1(0) = Points(0): pt1(1) = Points(1): pt1(2) = 0
  pt2(0) = Points(2): pt2(1) = Points(3): pt1(2) = 0
  Set BlockRef = ThisDrawing.ModelSpace.InsertBlock(punktyBlok, FileToInsert, skala * 0.5, skala * 0.5, skala * 0.5, ThisDrawing.Utility.AngleFromXAxis(pt1, pt2))
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    


'WSTAWIAM DRUGI ZNACZNIK STRZAŁKI JAKO BLOK I PRZEKRĘCAM GO O 90st

punktyBlok(0) = Points(2): punktyBlok(1) = Points(3): punktyBlok(2) = 0
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  FileToInsert = "C:\BLOKI\STRZALKA.dwg"
  Set BlockRef = ThisDrawing.ModelSpace.InsertBlock(punktyBlok, FileToInsert, skala * 0.5, skala * 0.5, skala * 0.5, ThisDrawing.Utility.AngleFromXAxis(pt2, pt1))
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    
  
    
'CHCIAŁBYM ABY MOJA LINIA, I 2 BLOKI STRZAŁKI BYŁY TUTAJ ZGRUPOWANE
    
    
    
    
Call ZapiszUstawienia(frm_ZP.Controls, "ZP_plus")

End Sub

 

Edytowane przez pop3k
Odnośnik do komentarza
Udostępnij na innych stronach

Uwaga ogólna:

Oddzielaj kod obsługi zdarzeń od kodu wykonawczego. Kod wykonawczy dziel na mniejsze funkcje. Spagetti code jest trudny do analizy i testowania. Jeżeli kod wykonawczy tworzy encje to te encje twórz w podfunkcjach które będą je zwracały do kodu wykonawczego. Zgromadzone encje do zgrupowania przekaż do osobnej funkcji jako argument. Funkcja ta powinna zwrócić identyfikator grupy.

Co do grupowania to może taki krótki przykład pomoże

Function Rysuj()

Dim Points(3) As Double
Dim PIERWSZY, DRUGI, TRZECI, CZWARTY As Variant
Dim ObjectsToGroup(1) As ZcadEntity
Dim Group As ZcadGroup


PIERWSZY = ThisDrawing.Utility.GetPoint(, "Podaj punkt P1 (początek pręta):")
DRUGI = ThisDrawing.Utility.GetPoint(PIERWSZY, "Podaj punkt P2 (koniec pręta):")
Points(0) = PIERWSZY(0)
Points(1) = PIERWSZY(1)
Points(2) = DRUGI(0)
Points(3) = DRUGI(1)

Set ObjectsToGroup(0) = ThisDrawing.ModelSpace.AddLightWeightPolyline(Points)

PIERWSZY = ThisDrawing.Utility.GetPoint(, "Podaj punkt P1 (początek pręta):")
DRUGI = ThisDrawing.Utility.GetPoint(PIERWSZY, "Podaj punkt P2 (koniec pręta):")
Points(0) = PIERWSZY(0)
Points(1) = PIERWSZY(1)
Points(2) = DRUGI(0)
Points(3) = DRUGI(1)

Set ObjectsToGroup(1) = ThisDrawing.ModelSpace.AddLightWeightPolyline(Points)

Set Group = ToGroup(ObjectsToGroup)

End Function


Function ToGroup(Objects() As ZcadEntity) As ZcadGroup

Dim GroupObject As ZcadGroup

Set GroupObject = ThisDrawing.Groups.Add("*")

GroupObject.AppendItems Objects

Set ToGroup = GroupObject

End Function

 

Odnośnik do komentarza
Udostępnij na innych stronach

Ha! Trzeba było zobaczyć mój kod na początku. Staram się dzielić kod na mniejsze funkcje, zazwyczaj jednak przy rewizjach poprawiam strukturę kodu. Mało to profesjonalne, ale ja jestem amator. Do tego zachowuje też porządek w deklaracji zmiennych - wszystkie są na początku i czasem nawet uporządkowuję je alfabetycznie!

Kod działa! Dziękuję bardzo! perlon jesteś Mistrzem!

 

Odnośnik do komentarza
Udostępnij na innych stronach

Dołącz do dyskusji

Możesz dodać zawartość już teraz a zarejestrować się później. Jeśli posiadasz już konto, zaloguj się aby dodać zawartość za jego pomocą.

Gość
Dodaj odpowiedź do tematu...

×   Wklejono zawartość z formatowaniem.   Usuń formatowanie

  Dozwolonych jest tylko 75 emoji.

×   Odnośnik został automatycznie osadzony.   Przywróć wyświetlanie jako odnośnik

×   Przywrócono poprzednią zawartość.   Wyczyść edytor

×   Nie możesz bezpośrednio wkleić grafiki. Dodaj lub załącz grafiki z adresu URL.

Ładowanie