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í.
