Abychom mohli v aplikaci používat veřejné (globální) proměnné, musíme je deklarovat ve standardním modulu, jinak by tyto proměnné nebyly veřejné (i v případě, že by byly deklarované jako public!)
V aplikaci budeme potřebovat následující veřejné (globální) proměnné:
Veřejné proměnné deklarujeme v tzv. modulu. Modul vytvoříme následujícím postupem:
Do otevřeného okna kódu napište deklaraci proměnných. Všechny proměnné musí být veřejné = deklarované pomocí Public:
'deklarace globalních proměnných Public gblnOptButtKruznice As Boolean ' ovladaní radio_buttonu Public gvarStredKruz As Variant ' hodnota souřadnic středu kružnice Public gvarStredKvad As Variant ' hodnota souřadnic středu Kvádru Public gdblPolomerKruz As Double ' poloměr kružnice Public gdblPocetKruz As Double ' počet kružnic Public gdblVzdalenostKruz As Double ' vzdálenost mezi kružnicemi Public gdblHloubkaKvad As Double ' hloubka Kvádru Public gdblSirkaKvad As Double ' šířka Kvádru Public gdblVyskaKvad As Double ' výška Kvádru Public gdblPocetKvad As Double ' počet zobrazených Kvádrů Public gdblVzdalenostKvad As Double ' vzdálenost mezi Kvádrumi Public gblnVykreslovat As Boolean ' logicka promenna pro odchyceni tlacitek OK/Cencel
Projekt soustrednéObjekty bude obsahovat tyto procedury:
Všechny procedury budeme zadávat s pomocí dialogového boxu Přidat proceduru.
Stejným způsobem vytvoříme i ostatní procedury NastaveniKruznice(), NastaveniKvadru() a Inicializace().
Během psaní funkcí Vám VBA se psaním kódu programu bude pomáhat pomocí funkce IntelliSense.
Public Sub soustredneObjekty() Dim AppObj As AcadApplication Dim circleObj As AcadCircle Dim boxObj As Acad3DSolid 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 ' vymazní objektu Err po odstranění chyby End If Inicializace ' zavolání procedury Inicializace UserForm1.Show 'zobrazení formuláře pro zadání hodnot If gboolVykreslovat Then ' jak byl ukončen formulář, True = kesli If (gblnOptButtKruznice = True) Then ' co se bude kreslit True = Kružnice Dim dblAktualPolomerKruz As Double ' aktuální poloměr kreslené kružnice While (gdblPocetKruz > 0) ' dokud je počet kružnic > 0 kresli dblAktualPolomerKruz = gdblPolomerKruz + _ (gdblVzdalenostKruz * (gdblPocetKruz - 1)) ' získání aktuálního poloměru Set circleObj = AppObj.Application.ActiveDocument. _ ModelSpace.AddCircle(gvarStredKruz, dblAktualPolomerKruz) ' nakreslení kružnice v modelovém prostoru gdblPocetKruz = gdblPocetKruz - 1 ' zmenšemí počtu ještě nevykreslených kružnic Wend Else ' kreslit se budou Kvádru Dim gdblAktHloubkaKvad As Double Dim gdblAktSirkaKvad As Double Dim gdblAktVyskaKvad As Double ' aktuální rozměry stran Kvádru While (gdblPocetKvad > 0) ' dokud je počet Kvádrů > 0 kresli gdblAktHloubkaKvad = (gdblPocetKvad - 1) * _ ((2 * gdblVydalenostKvad) + gdblHloubkaKvad) gdblAktSirkaKvad = (gdblPocetKvad - 1) * _ ((2 * gdblVydalenostKvad) + gdblSirkaKvad) gdblAktVyskaKvad = (gdblPocetKvad - 1) * _ ((2 * gdblVydalenostKvad) + gdblVyskaKvad) ' získání aktuálních rozměrů kreslené Kvádru Set boxObj = AppObj.Application.ActiveDocument. _ ModelSpace.AddBox(gvarStredKvad, gdblAktHloubkaKvad, _ gdblAktSirkaKvad, gdblAktVyskaKvad) ' nakreslení Kvádru v modelovém prostoru gdblPocetKvad = gdblPocetKvad - 1 ' zmenšemí počtu ještě nevykreslených Kvádrů Wend ' změna pohledu Dim NewDirection(0 To 2) As Double NewDirection(0) = -1 NewDirection(1) = -1 NewDirection(2) = 1 ThisDrawing.ActiveViewport.Direction = NewDirection ThisDrawing.ActiveViewport = ThisDrawing.ActiveViewport End If ThisDrawing.Application.ZoomExtents ' zvětšení výkresu Else MsgBox ("Spatné zadání nebo byl dialog stornován") ' zobrazení chybové zprávy End If End Sub
Kód procedury NastaveniKruznice() nastaví tlačítka pro zadání parametrů kreslení soustředných kružnic a zakáže změny tlačítek Kvádru. Ve funkci si všimněte nastavení hodnoty radio tlačítka a nastavení zobrazované hodnoty rozbalovacího seznamu.
Public Sub NastaveniKruznice() ' nastavení viditelnosti prvků pro zadání kružnice gblnOptButtKruznice = True UserForm1.OptionButton1.Value = True UserForm1.TextBox1.Enabled = True UserForm1.TextBox2.Enabled = True UserForm1.TextBox3.Enabled = True UserForm1.TextBox7.Enabled = True UserForm1.TextBox8.Enabled = True UserForm1.TextBox9.Enabled = True UserForm1.ScrollBar1.Enabled = True UserForm1.ScrollBar2.Enabled = True UserForm1.ScrollBar3.Enabled = True UserForm1.ScrollBar4.Enabled = True UserForm1.ComboBox1.Value = "Kružnice" UserForm1.CommandButton1.Enabled = True UserForm1.OptionButton2.Value = False UserForm1.TextBox4.Enabled = False UserForm1.TextBox5.Enabled = False UserForm1.TextBox6.Enabled = False UserForm1.TextBox10.Enabled = False UserForm1.TextBox11.Enabled = False UserForm1.TextBox12.Enabled = False UserForm1.TextBox13.Enabled = False UserForm1.TextBox14.Enabled = False UserForm1.CommandButton2.Enabled = False UserForm1.ScrollBar4.Enabled = False UserForm1.ScrollBar5.Enabled = False UserForm1.ScrollBar6.Enabled = False UserForm1.ScrollBar7.Enabled = False UserForm1.ScrollBar8.Enabled = False End Sub
Kód procedury NastaveniKvadru() nastaví tlačítka pro zadání parametrů kreslení soustředných kvádrů a zakáže změny tlačítek kružnice. Ve funkci si všimněte nastavení hodnoty radio tlačítka a nastavení zobrazované hodnoty rozbalovacího seznamu.
Public Sub NastaveniKvadru() ' nastavení viditelnosti prvků pro zadání Kvádru gblnOptButtKruznice = False UserForm1.OptionButton1.Value = False UserForm1.TextBox1.Enabled = False UserForm1.TextBox2.Enabled = False UserForm1.TextBox3.Enabled = False UserForm1.TextBox7.Enabled = False UserForm1.TextBox8.Enabled = False UserForm1.TextBox9.Enabled = False UserForm1.CommandButton1.Enabled = False UserForm1.ScrollBar1.Enabled = False UserForm1.ScrollBar2.Enabled = False UserForm1.ScrollBar3.Enabled = False UserForm1.ScrollBar4.Enabled = False UserForm1.ComboBox1.Value = "Kvádru" UserForm1.OptionButton2.Value = True UserForm1.TextBox4.Enabled = True UserForm1.TextBox5.Enabled = True UserForm1.TextBox6.Enabled = True UserForm1.TextBox10.Enabled = True UserForm1.TextBox11.Enabled = True UserForm1.TextBox12.Enabled = True UserForm1.TextBox13.Enabled = True UserForm1.TextBox14.Enabled = True UserForm1.CommandButton2.Enabled = True UserForm1.ScrollBar4.Enabled = True UserForm1.ScrollBar5.Enabled = True UserForm1.ScrollBar6.Enabled = True UserForm1.ScrollBar7.Enabled = True UserForm1.ScrollBar8.Enabled = True End Sub
Kód procedury Inicializace() zajišťuje inicializaci prvků frmuláře na správné hodnoty. Všimněte si zejména nastavení mezních hodnot pro posuvníky (pomocí vlastnosti min a max). Na konci funkce je definování jednotlivých položek rozbalovacího seznamu pomocí metody AddItem.
Public Sub Inicializace() gblnVykreslovat = False ' pocatecní hodnota - nevykresluj nic ' nastavení počátečních hodnot prvků UserForm1.ScrollBar1.Min = 1 UserForm1.ScrollBar1.Max = 100 UserForm1.ScrollBar2.Min = 1 UserForm1.ScrollBar2.Max = 100 UserForm1.ScrollBar3.Min = 1 UserForm1.ScrollBar3.Max = 100 UserForm1.ScrollBar4.Min = 1 UserForm1.ScrollBar4.Max = 100 UserForm1.ScrollBar5.Min = 1 UserForm1.ScrollBar5.Max = 100 UserForm1.ScrollBar6.Min = 1 UserForm1.ScrollBar6.Max = 100 UserForm1.ScrollBar7.Min = 1 UserForm1.ScrollBar7.Max = 100 UserForm1.ScrollBar8.Min = 1 UserForm1.ScrollBar8.Max = 100 UserForm1.ComboBox1.AddItem ("Kružnice") UserForm1.ComboBox1.AddItem ("Kvádru") ' konec nastavení počátečních hodnot NastaveniKruznice ' zavolej funkci pro nastavení viditelnosti End Sub
Nyní nám zbývá dopsat kód obslužných funkcí.