Message 1 sur 3
- Marquer comme nouveau
- Marquer
- S'abonner
- Sourdine
- S'abonner au fil RSS
- Lien permanent
- Imprimer
- Signaler
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
Résolu ! Accéder à la solution.