Pomoc pro ztracené programátory - makro s formuláři

Přehled informací

Vytvoření samostatného projektu

Samostatný projekt vytvoříme v prostředí AutoCADu následujícím postupem:

Aktivace nového projektu v prostředí VBA IDE

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.

Vytvoření nového modulu s deklarací veřejných proměnných

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

Vytvoření procedury praceSPrvky()

Všechny procedury budeme zadávat pomocí dialogového boxu Přidat proceduru.

Postup přidání nové procedury pomocí dialogového boxu Přidat proceduru

    Public Sub praceSPrvky()
      UserForm1.Show
                   ' zobrazení formuláře      
    End Sub

Obslužné kódy jednotlivých prvků formuláře

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.

Příkazové tlačítko pro získání souřadnic středu - CommandButton1

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

Příkazové tlačítko pro zadání druhého bodu - CommandButton2

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

Příkazové tlačítko pro vložení obrazce do scény - CommandButton3

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


Příkazové tlačítko pro výpočet obsahu - CommandButton4

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


Příkazové tlačítko pro ukončení makra - CommandButton5

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

Zdrojové kódy je možné stáhnout zde:

Spuštění procedury (makra) z prostředí VBA IDE

V IDE VBA otevřete Oknem kódu a umístěte kurzor do procedury praceSPrvky().

Makro můžete spustit následujícími způsoby:

Pokud se potřebujete dozvědět jak spustit makro z prostředí AutoCADu prostudujte si lekci Spuštění makra.