Dostal jsem výkres, kde jsou stejné bloky uloženy vždy pod jiným ménem. Třeba jeden blok je tam 63x pod 63 jmény.
Jak ve VBA nahradit blok blokem.
Vím že bůžu projít všechny bloky, dokážu i jednotlivé bloky přejmenovat, potíž je v tom, že není možné přejmenovat na stéjné jméno více bloků (typů bloků) tím ho přepsat.
 
Jak na to?

Zdravim selectoval bych body a posléze kopiroval jeden blok.
Ale vo VBA neporadim.

Přejmenovat asi ne, ale nahradit bloky můžete pomocí BLOCKREPLACE - viz:
http://www.cadforum.cz/cadforum/qaID.asp?tip=1960

predpokladam, nechcete automaticky porovnavat
jednotlive bloky mezi sebou, a hledat ktere jsou si podobne
a nemate problem vytvorit seznam jak jednolive
bloky nahrazovat
 
ve vykrese (Model, Layouts) vyhledejte objekty
BlockReference
a nahradte je dle potreby asi takto, vycistenim
vykresu se pak zbavite nepotrebnych definic
 
Public Sub XXX()Dim BlockRefObj As
AcadEntityFor Each BlockRefObj In ThisDrawing.ModelSpace    If
BlockRefObj.ObjectName = "AcDbBlockReference" Then        If
BlockRefObj.Name = "63a" Then BlockRefObj.Name = "63"        If
BlockRefObj.Name = "63b" Then BlockRefObj.Name = "63"    End
IfNextEnd Sub

Zdravím, tak s tímhle jsem se taky setkal při podkladech z DGN jsem obdržel soubor se spoustou graficky stejných bloků s názvy např. strom$1, strom$2 až strom$1536.
V tomto případě nezabere ani BLOCKREPLACE protože umožní vybrat jen jeden název bloku pro nahrazení a dělat to 1536x …
Vytvořit ručně seznam pro nahrazení tolika bloků asi taky není moc příjemné.
Takže tady je makro pro nahrazení mnoha různých bloků blokem jedním.
Není úplně ošetřeno na chyby a tak postupujte takto:
1. spusťte makro
2. při běhu na obrazovce vyberte bloky, které chcete nahradit (výběr ukončete enter nebo PTM)
3. vyberte blok, kterým chcete vybrané bloky nahradit 
 
Sub Blok2Bloky()'provede nahrazení vybraných bloků novým blokemDim vybránblok As BooleanDim aktivobj As AcadEntityDim blok2 As AcadEntityDim Vklbod(0 To 2) As DoubleDim pomset As AcadSelectionSetDim aktset As AcadSelectionSetDim bodík As Variant
For Each pomset In ThisDrawing.SelectionSets    If pomset.Name = "ss1" Then        pomset.Delete 'čistě pro jistotu, pokud po nějakém zhroucení ještě výběr ss1 existuje        Exit For    End IfNext pomset    Set pomset = ThisDrawing.SelectionSets.Add("ss1") 'čistý výběr    ThisDrawing.Utility.Prompt "Vyberte bloky pro nahrazení"    Dim intType(0) As Integer    Dim varData(0) As Variant    intType(0) = 0    varData(0) = "INSERT"        pomset.SelectOnScreen intType, varData    ThisDrawing.Utility.Prompt ""        vybránblok = False    Do Until vybránblok        ThisDrawing.Utility.GetEntity blok2, bodík, "Vyberte blok pro nahrazení vybraných bloků. Blok nesmí být součástí výběru pro nahrazení."        If StrComp(blok2.ObjectName, "AcDbBlockReference", vbTextCompare) = 0 Then            vybránblok = True        Else            MsgBox "Vybraný objekt není blok! Zkuste výběr znovu", vbOKOnly            vybránblok = False        End If    LoopFor Each aktivobj In pomset
    On Error Resume Next     Select Case aktivobj.ObjectName    Case "AcDbBlockReference"      Dim br1 As AcadBlockReference      Dim Novyblk As AcadBlockReference      Set br1 = aktivobj      Set Novyblk = ThisDrawing.ModelSpace.InsertBlock(br1.InsertionPoint, blok2.Name, 1, 1, 1, br1.Rotation) 'na původní pozici a se stejnou rotací vloží nový blok      br1.Delete 'po nahrazení bloku smazat původní blok
    End SelectNext aktivobjThisDrawing.SelectionSets("ss1").DeleteEnd Sub
 Chop2007-01-05 06:36:00

To je určitě užitečná funkce - jen pozor, neřeší řadu speciálních případů, ke kterým může běžně dojít (zamčené hladiny, vnořené bloky, atd.). Ty jsou právě ošetřeny v BLOCKREPLACE - ten lze spustit i řádkově (-BLOCKREPLACE) a také vybírat bloky ukázáním nebo jej zavolat ve smyčce se seznamem bloků.

jak udělat seznam, resp. smyčku pro seznam více bloků pro nahrazení jedním blokem
Máme převedené DGN a v něm blok 6.702 a jeho "klony" 6.702_10, ...202 atd. Abychom nemuseli nahrazovat blok po bloku