[VBA] Grupuj

[pop3k]

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 25 Lipca 2020 przez pop3k

[perlon]

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

 

[pop3k]

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!