Command to erase blocks containing a tag.

Command to erase blocks containing a tag.

david_rock
Enthusiast Enthusiast
338 Visites
2 Réponses
Message 1 sur 3

Command to erase blocks containing a tag.

david_rock
Enthusiast
Enthusiast

Hello,

I'm trying to write a command to delete blocks which contain a certain attribute tag. However it is deleting more than just the blocks. Its erasing most of the text as well. Any ideas?

 

    Public Sub ErBlWithTag()
        Dim acDoc As Document = Core.Application.DocumentManager.MdiActiveDocument
        Dim acCurDb As Database = acDoc.Database
        Dim ed As Editor = acDoc.Editor
        Try
            Dim pStrOpts As New PromptStringOptions(vbLf & "Enter the TAG name to erase blocks with this tag: ") With {
                .AllowSpaces = False
            }
            Dim pStrRes As PromptResult = ed.GetString(pStrOpts)
            If pStrRes.Status = PromptStatus.OK Then
                Dim strBlockWithTagNameToDelete As String = pStrRes.StringResult
                Dim acTrans As Transaction = acCurDb.TransactionManager.StartTransaction
                Using acTrans
                    Dim bt As BlockTable = CType(acTrans.GetObject(acCurDb.BlockTableId, OpenMode.ForWrite), BlockTable)
                    Dim strBlockNames As String = ""
                    Dim ListofBTR As New List(Of BlockTableRecord)
                    For Each btrId As ObjectId In bt
                        Dim btr As BlockTableRecord = CType(acTrans.GetObject(btrId, OpenMode.ForWrite), BlockTableRecord)
                        If Not btr.IsFromExternalReference And Not btr.IsLayout And Not btr.IsAnonymous Then
                            Dim blockContainsTag As Boolean = False
                            For Each id As ObjectId In btr
                                Dim obj As DBObject = acTrans.GetObject(id, OpenMode.ForWrite)
                                If TypeOf obj Is AttributeDefinition Then
                                    Dim attDef As AttributeDefinition = TryCast(obj, AttributeDefinition)
                                    ' Retrieve attribute definition tag name
                                    Dim attTagName As String = attDef.Tag
                                    clsRockAUTOMessaging.RockAUTO_Prompt("Searching Block '" & btr.Name & "' Attribute Tag Name '" & attTagName & "'")
                                    'Console.WriteLine("Attribute Tag Name: " & attTagName)
                                    If attTagName.ToUpper.Equals(strBlockWithTagNameToDelete.ToUpper) Then
                                        'If clsString.RockCADSupport_TestStringWithSplitAndLike(",", attTagName, strBlockWithTagNameToDelete) Then
                                        blockContainsTag = True
                                        clsRockAUTOMessaging.RockAUTO_Prompt_NoCrLf("...Found...")
                                        Exit For
                                    End If
                                End If
                            Next
                            If blockContainsTag Then
                                ListofBTR.Add(btr)
                                If strBlockNames.Equals("") Then
                                    strBlockNames = btr.Name
                                Else
                                    strBlockNames &= "," & btr.Name
                                End If
                                'btr.UpgradeOpen()
                                'btr.Erase(True)
                            End If
                        End If
                    Next
                    For Each objBlockTableRecord As BlockTableRecord In ListofBTR
                        'objBlockTableRecord.UpgradeOpen()
                        objBlockTableRecord.Erase(True)
                    Next

                    acTrans.Commit()
                    Core.Application.DocumentManager.MdiActiveDocument.Editor.Regen()
                    ed.WriteMessage(vbLf & "Blocks with name '{0}' deleted successfully.", strBlockNames)
                End Using
            End If
        Catch ex As Exception
            ed.WriteMessage(ex.ToString())
        End Try
    End Sub
0 J'aime
Solutions acceptées (1)
339 Visites
2 Réponses
Replies (2)
Message 2 sur 3

_gile
Consultant
Consultant
Solution acceptée

Hi,

If I do not misunderstand what you're trying to achieve, this should work (sorry it's C#).

private static List<string> EraseBlockWithTag (string tag)
{
    var doc = Application.DocumentManager.MdiActiveDocument;
    var db = doc.Database;
    var ed = doc.Editor;
    var blockNames = new List<string>();
    using (var tr = db.TransactionManager.StartTransaction())
    {
        var blockTable = (BlockTable)tr.GetObject(db.BlockTableId, OpenMode.ForRead);
        foreach (ObjectId btrId in blockTable)
        {
            var btr = (BlockTableRecord)tr.GetObject(btrId, OpenMode.ForRead);
            if (btr.IsLayout || 
                btr.IsDependent || 
                btr.IsFromExternalReference || 
                btr.IsAnonymous || 
                !btr.HasAttributeDefinitions)
                continue;

            foreach (ObjectId id in btr)
            {
                if (id.ObjectClass.Name == "AcDbAttributeDefinition")
                {
                    var attrib = (AttributeDefinition)tr.GetObject(id, OpenMode.ForRead);
                    if (attrib.Tag.Equals(tag, StringComparison.OrdinalIgnoreCase))
                    {
                        // Try to erase all references to this block definition and purge the block definiton
                        try
                        {
                            tr.GetObject(btrId, OpenMode.ForWrite);
                            foreach (ObjectId brId in btr.GetBlockReferenceIds(true, true))
                            {
                                tr.GetObject(brId, OpenMode.ForWrite).Erase();
                            }
                            btr.Erase();
                            blockNames.Add(btr.Name);
                        }
                        catch(System.Exception ex)
                        {
                            ed.WriteMessage($"\nUnable to erase '{btr.Name}': {ex.Message}");
                        }
                        break;
                    }
                }
            }
        }
        tr.Commit();
    }
    return blockNames;
}


Gilles Chanteau
Programmation AutoCAD LISP/.NET
GileCAD
GitHub

Message 3 sur 3

david_rock
Enthusiast
Enthusiast

Perfect thank you so much!

0 J'aime