Samostatný projekt vytvoříme v prostředí AutoCADu následujícím postupem:
V prostředí IDE VBA aktivujte nový projekt. Projekt aktivujete pomocí okna Projekt - ACADProjekt dvojklikem nad jménem nového projektu (Global2). Situaci znázorňuje následující obrázek:
Kód celého makra bude napsán ve standartním modulu.
Veřejné proměnné deklarujeme v tzv. modulu. Modul vytvoříme následujícím postupem:
Public gvarBod1 As Variant ' hodnota souřadnic středu kružnice Public gvarBod2 As Variant ' hodnota souřadnic středu Kvádru Public polomer As Double ' poloměr kružnice
Všechny procedury budeme zadávat pomocí dialogového boxu Přidat proceduru.
Public Sub praceSPrvky() UserForm1.Show ' zobrazení formuláře End Sub
V dalším výkladu uvádíme popis vždy jen pro jeden prvek (ostatní se většinou liší jen proměnnými, do kterých se ukládají nebo získávají hodnoty), u ostatních je uveden jen okomentovaný kód funkce.
Obslužná procedura tlačítka Vlož bod1, bude reagovat na stisknutí tlačítka. Procedura umožní zadat souřadnice středu bodu objektu. Kód procedury bude obahovat následující části:
V kódu procedury si všimněte způsob práce se souřadnicemi (získanými metodou GetPoint). Pokud byste se pokusili souřadnice přiřadit rovnou do textového pole (TextBox1.Value = gvarStredKruz(0)) došlo by k chybě.
Private Sub CommandButton1_Click() ' vyvolání procedury při kliknutí nad prvkem Dim souradnice(0 To 2) As Double ' deklarace proměnné pole souřadnic středu obrazce On Error Resume Next ' při výskytu chyby pokračuj na dalším příkazu Call Me.Hide ' skrytí formuláře (dialogového boxu) gvarBod1 = ThisDrawing.Utility.GetPoint _ (, "Zadej střed kružnice: ") ' pokus získání hodnoty souřadnic bodu If Err <> 0 Then ' v případě výskytu chyby pokračuj zde Err.Clear ' vymaž kontainer s chybami MsgBox ("Uživatel ukončil činnost") ' zobraz zprávu Exit Sub ' přeruš proceduru End If souradnice(0) = CInt(gvarBod1(0)) souradnice(1) = CInt(gvarBod1(1)) souradnice(2) = CInt(gvarBod1(2)) ' nastavení souřadnic do pomocné proměnné TextBox1.Visible = True TextBox2.Visible = True TextBox3.Visible = True Label1.Visible = True Label2.Visible = True Label3.Visible = True CommandButton1.Visible = False ' nastavení viditelnosti prvků formuláře CommandButton2.Enabled = True ' aktivování tlačítka CommandButton2 TextBox1.Value = souradnice(0) TextBox2.Value = souradnice(1) TextBox3.Value = souradnice(2) ' zobrazení hodnot souřadnic středu ve formuláři ' CInt - převod souřadnic na integer Call Me.Show ' opětovné zobrazení formuláře End Sub
Obslužná procedura tlačítka Vlož bod2, bude reagovat na stisknutí tlačítka. Procedura umožní zadat souřadnice druhého bodu, z rozdílu se vypočítá poloměr kružnice. Kód procedury bude obahovat následující části:
Private Sub CommandButton1_Click() ' vyvolání procedury při kliknutí nad prvkem Dim souradnice(0 To 2) As Double ' deklarace proměnné pole souřadnic středu obrazce On Error Resume Next ' při výskytu chyby pokračuj na dalším příkazu Call Me.Hide ' skrytí formuláře (dialogového boxu) gvarBod2 = ThisDrawing.Utility.GetPoint _ (, "Zadej druhý bod: ") ' pokus získání hodnoty souřadnic bodu If Err <> 0 Then ' v případě výskytu chyby pokračuj zde Err.Clear ' vymaž kontainer s chybami MsgBox ("Uživatel ukončil činnost.") ' zobraz zprávu Exit Sub ' přeruš proceduru End If TextBox4.Visible = True Label4.Visible = True CommandButton2.Visible = False ' nastavení viditelnosti prvků formuláře CommandButton3.Enabled = True ' aktivování tlačítka CommandButton3 polomer = Sqr((gvarBod1(0) - gvarBod2(0)) ^ 2 + _ (gvarBod1(1) - gvarBod2(1)) ^ 2 + _ (gvarBod1(2) - gvarBod2(2)) ^ 2) ' výpočet poloměru kružnice TextBox4.Value = CInt(polomer) ' zobrazení hodnoty poloměru ' CInt - převod souřadnic na integer Call Me.Show ' opětovné zobrazení formuláře End Sub
Obslužná procedura tlačítka Vykresli objekt, bude reagovat na stisknutí tlačítka. Procedura vykreslí kružnici do scény. Kód procedury bude obahovat následující části:
Private Sub CommandButton3_Click() ' vyvolání procedury při kliknutí Dim AppObj As AcadApplication Dim circleObj As AcadCircle Dim boxObj As Acad3DSolid ' deklarace proměnných On Error Resume Next 'při běhové chybě pokračuje program příkazem 'následujícím příkaz, při kterém nastala chyba. Set AppObj = GetObject(, "AutoCAD.Application") ' získání instance objektu AutoCAD.Application If Err Then ' objekt neexistuje - AutoCAD není spuštěn Set AppObj = CreateObject("AutoCAD.Application") ' vytvořen objekt aplikace AutoCAD Err.Clear ' vymazání objektu Err po odstranění chyby End If Set circleObj = AppObj.Application.ActiveDocument. _ ModelSpace.AddCircle(gvarBod1, polomer) ' nakreslení kružnice v modelovém prostoru ThisDrawing.Application.ZoomExtents ' zvětšení výkresu CommandButton3.Visible = False ' nastavení viditelnosti prvků form. CommandButton4.Enabled = True ' aktivování tlačítka commandButton4 End Sub
Obslužná procedura tlačítka Vypočítej poloměr, bude reagovat na stisknutí tlačítka. Procedura vypočítá obsah kružnice a hodnotu zobrazí do textového pole. Kód procedury bude obsahovat následující části:
Private Sub CommandButton4_Click() ' vyvolání procedury při kliknutí TextBox5.Value = CInt(3.14 * polomer ^ 2) ' nastavení textového pole obsah CommandButton4.Visible = False ' nastavení viditelnosti prvků form. CommandButton5.Visible = True ' aktivování tlačítka commandButton5 End Sub
Obslužná procedura tlačítka Konec, bude reagovat na stisknutí tlačítka. Procedura odstraní formulář z paměti. Kód procedury bude obsahovat následující část:
Private Sub CommandButton5_Click() ' vyvolání procedury při kliknutí Unload Me ' odstranění formuláře End Sub
Zdrojové kódy je možné stáhnout zde:
V IDE VBA otevřete Oknem kódu a umístěte kurzor do procedury praceSPrvky().
Pokud se potřebujete dozvědět jak spustit makro z prostředí AutoCADu prostudujte si lekci Spuštění makra.