Page 2 of 2 FirstFirst 12
Results 11 to 13 of 13

Thread: Help with deleting multiple copies of blocks (not anon) with selection set

  1. #11
    I could stop if I wanted to
    Join Date
    2007-08
    Posts
    202
    Login to Give a bone
    0

    Default Re: Help with deleting multiple copies of blocks (not anon) with selection set

    Hi,

    Here's what could be your 'Eraser' method. I also made some changes (removed unusefull statements) to the BlockTest one.
    It seems to work (VB is not at all my favorite language).

    Code:
            Private Sub Eraser()
                Dim doc As Document = Application.DocumentManager.MdiActiveDocument
                Dim db As Database = doc.Database
                Dim ed As Editor = doc.Editor
                Dim filter As TypedValue() = {New TypedValue(0, "INSERT"), New TypedValue(2, "Standard,Compact,Handicap,Van")}
                Dim psr As PromptSelectionResult = ed.SelectAll(New SelectionFilter(filter))
                If psr.Status <> PromptStatus.OK Then
                    Return
                End If
                Using doc.LockDocument()
                    Using tr As Transaction = db.TransactionManager.StartTransaction()
                        For Each id As ObjectId In psr.Value.GetObjectIds()
                            Dim br As BlockReference = DirectCast(tr.GetObject(id, OpenMode.ForWrite), BlockReference)
                            br.[Erase]()
                        Next
                        tr.Commit()
                    End Using
                End Using
            End Sub
    
            Private Sub BlockTest(blockName As String)
                Dim doc As Document = Application.DocumentManager.MdiActiveDocument
                Dim db As Database = doc.Database
                Dim ed As Editor = doc.Editor
                Using doc.LockDocument()
                    Using tr As Transaction = db.TransactionManager.StartTransaction()
                        Dim blockTable As BlockTable = DirectCast(tr.GetObject(db.BlockTableId, OpenMode.ForRead), BlockTable)
                        If Not blockTable.Has(blockName) Then
                            ed.WriteMessage(vbLf & "{0} block does not exist, now inserting source file!", blockName)
                            Dim filename As String = "C:\mkacadd_Hybrid\Civil3D\CAD data\Support\Blocks\StallCount.dwg"
                            Dim blkId As ObjectId
                            Using dbdwg As New Database(False, True)
                                dbdwg.ReadDwgFile(filename, FileShare.Read, True, "")
                                blkId = db.Insert(Path.GetFileNameWithoutExtension(filename), dbdwg, True)
                            End Using
                            ' Purge StallCount block
                            Dim btr As BlockTableRecord = DirectCast(tr.GetObject(blkId, OpenMode.ForWrite), BlockTableRecord)
                            btr.[Erase]()
                        End If
                        Me.Hide()
                        Dim id As ObjectId = blockTable(blockName)
                        Dim modelSpace As BlockTableRecord = _
                            DirectCast(tr.GetObject(blockTable(BlockTableRecord.ModelSpace), OpenMode.ForWrite), BlockTableRecord)
                        Dim ppo As New PromptPointOptions(vbLf & "Specify insertion point, (press ESC, SHIFT or ENTER to return): ")
                        ppo.AllowNone = True
                        Dim pao As New PromptAngleOptions(vbLf & "Specifiy the rotation: ")
                        pao.UseBasePoint = True
                        pao.DefaultValue = 0.0
                        pao.UseDefaultValue = True
                        While True
                            Dim ppr As PromptPointResult = ed.GetPoint(ppo)
                            If ppr.Status <> PromptStatus.OK Then
                                Exit While
                            End If
                            Dim pts As Point3d = ppr.Value
                            pao.BasePoint = pts
                            Dim pdr As PromptDoubleResult = ed.GetAngle(pao)
                            If pdr.Status = PromptStatus.Cancel Then
                                Exit While
                            End If
                            Dim angle As Double = pdr.Value
                            Dim br As New BlockReference(pts, id)
                            br.Rotation = angle
                            br.TransformBy(ed.CurrentUserCoordinateSystem)
                            modelSpace.AppendEntity(br)
                            tr.AddNewlyCreatedDBObject(br, True)
                            db.TransactionManager.QueueForGraphicsFlush()
                        End While
                        tr.Commit()
                    End Using
                End Using
                Counter()
                Me.Show()
            End Sub

  2. #12
    Member
    Join Date
    2010-08
    Posts
    40
    Login to Give a bone
    0

    Default Re: Help with deleting multiple copies of blocks (not anon) with selection set

    ahhh. i think i forgot the "doc.lockdocument" part when i was trying earlier. so got it to work now. One oddity, i assume this is happening because its being initiated from a windows form, but it does not actually erase anything until after the form is closed. Which is fine since erasing everything should be the last thing you are doing anyways.
    Code:
     Private Sub eraser()
            Dim doc As Document = Application.DocumentManager.MdiActiveDocument
            Dim db As Database = doc.Database
            Dim ed As Editor = doc.Editor
            Dim filter As TypedValue() = {New TypedValue(0, "INSERT"), New TypedValue(2, "Standard,Compact,Handicap,Van")}
            Dim psr As PromptSelectionResult = ed.SelectAll(New SelectionFilter(filter))
            If psr.Status <> PromptStatus.OK Then
                Return
            End If
            doc.LockDocument()
            Using tr As Transaction = db.TransactionManager.StartTransaction()
                For Each id As ObjectId In psr.Value.GetObjectIds()
                    Dim br As BlockReference = DirectCast(tr.GetObject(id, OpenMode.ForWrite), BlockReference)
                    br.Erase()
                Next
                tr.Commit()
            End Using
            Me.Close()
            Application.SetSystemVariable("clayer", Laycurrent.laycur)
        End Sub
    Thanks again for the help guys.

  3. #13
    I could stop if I wanted to
    Join Date
    2007-08
    Posts
    202
    Login to Give a bone
    0

    Default Re: Help with deleting multiple copies of blocks (not anon) with selection set

    You should explicitly call Dispose() on the doc.LockDocument()

    Code:
    Using doc.LockDocument()
        '...
    End Using

Page 2 of 2 FirstFirst 12

Similar Threads

  1. Increment copies of Blocks
    By Wish List System in forum AutoCAD Wish List
    Replies: 3
    Last Post: 2014-01-17, 02:55 AM
  2. Multiple Copies of AutoCAD
    By neilcheshire in forum AutoCAD General
    Replies: 6
    Last Post: 2010-01-25, 08:19 PM
  3. PUBLISH MULTIPLE COPIES
    By mike.schemm in forum AutoCAD Plotting
    Replies: 1
    Last Post: 2008-07-22, 03:57 AM
  4. Multiple rotate copies
    By cadkiller in forum Revit Architecture - General
    Replies: 1
    Last Post: 2005-08-01, 02:26 PM
  5. Bat Files for Deleting Backup copies
    By Zig in forum Revit Architecture - General
    Replies: 2
    Last Post: 2003-09-11, 04:20 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •