Sub klawiatura()
    zad1
End Sub
Private Function zad1()
    'Jak stworzyc blok z atrybutem:
    '1. narysuj figure 2d/3d
    '2. W widoku 2d (prawy dolny rog, zebatka, drawing & annotation) zaznaczasz blok, insert, create block
    '3. Po utworzeniu bloku zaznacz go, prawy przycisk myszy i edit block
    '4. Dajecie attribute definition, dodajecie tyle atrybutow ile chcecie, na pewno jeden przechowywujacy iksa
    '5. Zeby byc pewnym, ze atrybuty beda sie wyswietlac - przejdzcie na widok perspektywiczny i upewnijcie sie ze atrybut jest na/nad blokiem a nie w nim/pod nim
    '6. dodatkowo w properties mozecie wrzucic atrybut z iksem na inny layer o kolorze czarnym
    '7. W tym momencie przypomnialem sobie, ze w warcaby gra sie kolkami
    '8. No i to na tyle, robicie plansze z waszych blokow, szukacie (taki moj pomysl) blokow ktore maja atrybut poczatkowy = tak i na tej podstawie wstawiacie kolka do pozycji startowych, potem przy kazdym ruchu sprawdzacie pierwsze i drugie zaznaczone pole i robicie ruch lub wyswietlacie blad, kolka mozecie wstawic na 2 warstwach to beda mialy rozne kolory a wy i tak zaznaczacie caly blok przy kliknieciu
    ' Create a new selection set
    Dim sset As AcadSelectionSet
    Dim sset2 As AcadSelectionSet
    'Set sset = ThisDrawing.SelectionSets.Add("SS1")
    'Set sset2 = ThisDrawing.SelectionSets.Add("SS2")
    Set sset = ThisDrawing.SelectionSets("SS1")
    Set sset2 = ThisDrawing.SelectionSets("SS2")
    ' Prompt the user to select objects
    ' and add them to the selection set.
    ' To finish selecting, press ENTER.

    Dim layer As AcadLayer
    Dim layers As AcadLayers

    Set layers = ThisDrawing.layers

    For Each layer In layers    'ukrywanie warstw
        If layer.name = "klawisze" Or layer.name = "napisy" Then
            layer.LayerOn = False
        End If
    Next

    sset.Highlight (False)  'wylaczenie podswietlen
    Application.Update  'aktualizacja widoku
    sset.Clear  'wyczyszczenie selection setow, bardzo wazne zebyscie to ustawiali w dobrych miejscach bo moze wam sie syf tam pozbierac i program sie bedzie sypal
    sset2.Clear


    punkttabliczki = ThisDrawing.Utility.GetPoint(, "Wskaz, gdzie ma byc umieszczona tabliczka: ")
    Dim ModelSpace As AcadModelSpace
    Set ModelSpace = ActiveDocument.ModelSpace

    ReDim ssobjs(9) As AcadEntity   'metoda jakiej uzywam do wrzucenia nowych obiektow do selection seta, nie wiem czemu tak, ale inne nie dzialaly
    Set ssobjs(0) = ThisDrawing.ModelSpace.InsertBlock(punkttabliczki, "nazwa", 1, 1, 1, 0)
    Set ssobjs(1) = ThisDrawing.ModelSpace.InsertBlock(punkttabliczki, "nrrysunku", 1, 1, 1, 0)
    Set ssobjs(2) = ThisDrawing.ModelSpace.InsertBlock(punkttabliczki, "ilosc", 1, 1, 1, 0)
    Set ssobjs(3) = ThisDrawing.ModelSpace.InsertBlock(punkttabliczki, "material", 1, 1, 1, 0)
    Set ssobjs(4) = ThisDrawing.ModelSpace.InsertBlock(punkttabliczki, "masa", 1, 1, 1, 0)
    Set ssobjs(5) = ThisDrawing.ModelSpace.InsertBlock(punkttabliczki, "nazwisko", 1, 1, 1, 0)
    Set ssobjs(6) = ThisDrawing.ModelSpace.InsertBlock(punkttabliczki, "data", 1, 1, 1, 0)
    Set ssobjs(7) = ThisDrawing.ModelSpace.InsertBlock(punkttabliczki, "podzialka", 1, 1, 1, 0)
    Set ssobjs(8) = ThisDrawing.ModelSpace.InsertBlock(punkttabliczki, "format", 1, 1, 1, 0)
    Set ssobjs(9) = ThisDrawing.ModelSpace.InsertBlock(punkttabliczki, "masacalkowita", 1, 1, 1, 0)
    sset2.AddItems ssobjs   'tu wrzucam do selection seta

    For Each layer In layers    'wlaczenie widoku warstw
        If layer.name = "klawisze" Or layer.name = "napisy" Then
            layer.LayerOn = True
        End If
    Next

    Dim FilterType(0) As Integer
    Dim FilterData(0) As Variant

    Dim wybranyklawisz As AcadObject
    Dim punkt As Variant

    ThisDrawing.Utility.GetEntity wybranyklawisz, punkt, "" 'pobranie wybranego klawisza, w waszym wypadku to bedzie pole, mozecie uzyc ssobjs(1) zeby przechowywac wybrany pionek oraz wybrane pole docelowe
    ReDim ssobjs(0) As AcadEntity
    Set ssobjs(0) = wybranyklawisz
    sset.AddItems ssobjs

    Dim obj As Variant
    Set obj = sset.Item(0)

    Dim thisdwg As AcadDocument
    Set thisdwg = ThisDrawing

    Dim atr As Variant

    atr = obj.GetAttributes 'dobranie sie do atrybutow

    Dim txtstr As String
    Dim klawisz As String
    Dim klawiszduzy As String
    Dim capslock As Boolean
    Dim shift As Boolean
    Dim fresh As Boolean

    capslock = False
    shift = False
    tabliczka = 0
    Set obj2 = sset2.Item(tabliczka)
    atrtab = obj2.GetAttributes
    klawisz = atr(1).TextString 'pobranie drugiego atrybutu (bo leci od 0)
    While klawisz <> "enter"
        If klawisz = "tab" Then
            tabliczka = tabliczka + 1
            If tabliczka = 10 Then
                tabliczka = 0
            End If
            Set obj2 = sset2.Item(tabliczka)
            atrtab = obj2.GetAttributes

        ElseIf klawisz = "shift" Then 'jesli wcisniemy shift
            If shift = False Then
                shift = True
                fresh = True
            Else
                shift = False
            End If

        ElseIf klawisz = "capslock" Then 'jesli wcisniemy capslock
            If capslock = False Then
                capslock = True
            Else
                capslock = False
            End If

        ElseIf klawisz = "backspace" Then 'jesli wcisniemy backspace
            If Len(atrtab(2).TextString) > 0 Then
                atrtab(2).TextString = Left(atrtab(2).TextString, Len(atrtab(2).TextString) - 1)
            End If

        ElseIf klawisz = "spacja" Then
            atrtab(2).TextString = atrtab(2).TextString & " "   'edycja atrybutu, w waszym wypadku bedzie po prostu = "x" lub = ""

        ElseIf capslock = True Or shift = True Then 'jesli capslock lub shift jest wcisniety
            If shift = True And capslock = False Then
                klawiszduzy = atr(2).TextString
                atrtab(2).TextString = atrtab(2).TextString & klawiszduzy
            ElseIf shift = False And capslock = True Then
                klawiszduzy = atr(2).TextString
                atrtab(2).TextString = atrtab(2).TextString & klawiszduzy
            Else
                atrtab(2).TextString = atrtab(2).TextString & klawisz
            End If

        Else
            atrtab(2).TextString = atrtab(2).TextString & klawisz
        End If

        If fresh = False Then
            shift = False
        End If
        fresh = False

        sset.Highlight (False)
        Application.Update
        sset.Clear
        ThisDrawing.Utility.GetEntity wybranyklawisz, punkt, ""
        Set ssobjs(0) = wybranyklawisz
        sset.AddItems ssobjs

        Set obj = sset.Item(0)
        atr = obj.GetAttributes
        klawisz = atr(1).TextString

    Wend

    If klawisz = "enter" Then
        MsgBox "koniec"
    End If

    For Each layer In layers
        If layer.name = "klawisze" Or layer.name = "napisy" Then
            layer.LayerOn = False
        End If
    Next

    Application.Update
End Function