[VBA] Grupuj


Recommended Posts

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

 

Edited by pop3k
Link to comment
Share on other sites

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

 

Link to comment
Share on other sites

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!

 

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