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().
Spustit proceduru z nástrojové lišty Standardní,Pokud se potřebujete dozvědět jak spustit makro z prostředí AutoCADu prostudujte si lekci Spuštění makra.
