Jak nahradit entitu blokem?

Produkt: AutoCAD 2002-2008
Datum: 22.01.2002

Jedním problémem, se kterým se v praxi můžeme setkat, je otázka, jak snadno nahradit požadované entity jinými entitami. Pro náš příklad jsme si zvolili výměnu kružnice (popř. bodu) za blok s atributy. Kromě vlastní výměny, která je poměrně triviální, se seznámíme jak s výběrovými množinami, tak s atributy.

Výběrová množina nám umožní výběr více entit najednou. Při výběru můžeme použít nejenom různé způsoby výběru, ale také můžeme filtrovat entity např. podle typu. Pro vytvoření výběrové množiny slouží metoda Add kolekce SelectionSets:

    Dim oSel As AcadSelectionSet
	    
    Set oSel = ThisDrawing.SelectionSets.Add("Selection")

Protože počet výběrových množin není neomezný (ve výkrese můžeme mít až 128 pojmenovaných výběrových množin), je dobré před vytvořením výběrové množiny testovat, zda již výběrová množina zadaného jména neexistuje. Pokud výběrová množina již existuje, tak ji smažeme, příp. znovu využijeme namísto vytváření nové výběrové množiny:

    For Each oSel In ThisDrawing.SelectionSets
        If oSel.Name = "Selection" Then
            oSel.Delete
            Exit For
        End If
    Next

Další úkolem je nastavení filtru tak, abychom vybrali pouze kužnice. Pro výběr entit použijeme metodu SelectOnScreen, která má dva nepovinné parametry - typ fitru a data filtru. Pro naše účely nastavíme typ filtru na hodnotu 0 (= název entity) a data filtru na CIRCLE, což je název entity kružnice:

    Dim intType(0) As Integer
    Dim varData(0) As Variant
    
    intType(0) = 0
    varData(0) = "CIRCLE"
    
    oSel.SelectOnScreen intType, varData

Ve smyčce budeme procházet vybrané entity a do středu každé nalezené kružnice vložíme referenci bloku. Kružnici poté smažeme:

    For Each oCircle In oSel
        Dim oBlkref As AcadBlockReference
        
        'vložit nový blok namísto kružnice
        Set oBlkref = ThisDrawing.ModelSpace.InsertBlock(oCircle.Center, Blkname, 1#, 1#, 1#, 0#)
        'smazat kružnici
        oCircle.Delete
    Next

Dnešní příklad si ještě trochu zkomplikujeme tím, že budeme nastavovat hodnotu zvoleného atributu (v našem případě je to atribut ID) podle pořadového čísla vloženého bloku. K atributům přistupujeme pomocí metody GetAttributes. Jakmile jednou získáme pole atributů, můžeme s nimi již přímo pracovat:

   Dim varAttributes As Variant
        
   varAttributes = oBlkref.GetAttributes
   Dim i As Integer
        
   For i = LBound(varAttributes) To UBound(varAttributes)
       'pokud má atribut požadované jméno, tak vyplníme jeho hodnotu
       If varAttributes(i).Tag = Attname Then
           varAttributes(i).TextString = CStr(counter)
       End If
   Next

Pro větší zobecnění jsme název vkládaného bloku a hledaného atributu uložili do veřejných proměnných:

  Public Const Blkname = "TEST"
  Public Const Attname = "ID"

Výsledná funkce by tedy mohla vypadat následovně:

Public Const Blkname = "TEST"
Public Const Attname = "ID"

Sub ReplaceEntWithBlock()
    Dim oSel As AcadSelectionSet
    
    On Error Resume Next
    'pokud již výběrová možina existuje, tak ji smazat
    For Each oSel In ThisDrawing.SelectionSets
        If oSel.Name = "Selection" Then
            oSel.Delete
            Exit For
        End If
    Next
    ' vytvoříme novou
    Set oSel = ThisDrawing.SelectionSets.Add("Selection")
    ' nastavení dat pro výběr
    Dim intType(0) As Integer
    Dim varData(0) As Variant
    
    intType(0) = 0
    varData(0) = "CIRCLE"
    
    oSel.SelectOnScreen intType, varData
    
    Dim oCircle As AcadCircle
    Dim counter As Integer
    
    counter = 1
    ' projít výběr
    For Each oCircle In oSel
        Dim oBlkref As AcadBlockReference
        
        'vložit nový blok namísto kružnice
        Set oBlkref = ThisDrawing.ModelSpace.InsertBlock(oCircle.Center, Blkname, 1#, 1#, 1#, 0#)
        Dim varAttributes As Variant
        
        varAttributes = oBlkref.GetAttributes
        Dim i As Integer
        
        For i = LBound(varAttributes) To UBound(varAttributes)
          'pokud má atribut požadované jméno, tak vyplníme jeho hodnotu
          If varAttributes(i).Tag = Attname Then
            varAttributes(i).TextString = CStr(counter)
          End If
        Next
        'smazat kružnici
        oCircle.Delete
        counter = counter + 1
    Next
    ' uvolnit výběrovou množinu
    oSel.Delete
End Sub

Nyní již jen musíme vyvolat nově vytvořenou funkci. Ve spuštěném AutoCADu stiskněte Alt-F8 a v seznamu maker zvolte ReplaceEntWithBlock. Pro automatické spuštění lze využít např. příkaz APLČTI (_APPLOAD) a příkaz -VBARUN.

Ve VBA projektu (viz odkaz nahoře) jsou uloženy dvě verze kódu - jednak tato varianta s kružnicemi a jednak praktičtější verze nahrazující entity typu Bod (POINT).