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
oSelAs
AcadSelectionSetSet
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
oSelIn
ThisDrawing.SelectionSetsIf
oSel.Name = "Selection"Then
oSel.DeleteExit 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
IntegerDim
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
oCircleIn
oSelDim
oBlkrefAs
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.DeleteNext
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
varAttributesAs
Variant varAttributes = oBlkref.GetAttributesDim
iAs
IntegerFor
i = LBound(varAttributes)To
UBound(varAttributes)'pokud má atribut požadované jméno, tak vyplníme jeho hodnotu
If
varAttributes(i).Tag = AttnameThen
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:
Výsledná funkce by tedy mohla vypadat následovně:Public Const
Blkname ="TEST"
Public Const
Attname ="ID"
Public Const
Blkname ="TEST"
Public Const
Attname ="ID"
Sub
ReplaceEntWithBlock()Dim
oSelAs
AcadSelectionSetOn Error Resume Next
'pokud již výběrová možina existuje, tak ji smazat
For Each
oSelIn
ThisDrawing.SelectionSetsIf
oSel.Name ="Selection"
Then
oSel.DeleteExit For
End If
Next
' vytvoříme novou
Set
oSel = ThisDrawing.SelectionSets.Add("Selection"
)' nastavení dat pro výběr
Dim
intType(0)As
IntegerDim
varData(0)As
Variant intType(0) = 0 varData(0) ="CIRCLE"
oSel.SelectOnScreen intType, varDataDim
oCircleAs
AcadCircleDim
counterAs
Integer counter = 1' projít výběr
For Each
oCircleIn
oSelDim
oBlkrefAs
AcadBlockReference'vložit nový blok namísto kružnice
Set
oBlkref = ThisDrawing.ModelSpace.InsertBlock(oCircle.Center, Blkname, 1#, 1#, 1#, 0#)Dim
varAttributesAs
Variant varAttributes = oBlkref.GetAttributesDim
iAs
IntegerFor
i = LBound(varAttributes)To
UBound(varAttributes)'pokud má atribut požadované jméno, tak vyplníme jeho hodnotu
If
varAttributes(i).Tag = AttnameThen
varAttributes(i).TextString = CStr(counter)End If
Next
'smazat kružnici
oCircle.Delete counter = counter + 1Next
' uvolnit výběrovou množinu
oSel.DeleteEnd 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).
Copyright © 2002-2008 CAD Studio a.s.