Code:
Public Shared Function GetEntities(ByRef acDoc As Document, Optional ByVal Filter As SelectionFilter = Nothing, Optional ByVal SelectOnScreen As Boolean = False, _
Optional ByVal Prompt As String = "Select Objects: ") As ObjectIdCollection
'Filter can be filled out with multaple filters
' Filter = new SelectionFilter(FilterList)
' This is filled with a FilterList
' FilterList = TypedValue() array filled with TypedValue
' TypedValue is a TypedValue (Value Types can be found under the DXFCode)
' Select Blocks = New TypedValue(CInt(DxfCode.Start), "INSERT"
' Select by Layer = New TypedValue(CInt(DxfCode.LayerName), "layerName")
' To Select all, do not add a Filter
'
' 'OneLine Filter example to get all blocks
' GetEntities(New SelectionFilter(New TypedValue(0) {New TypedValue(CInt(DxfCode.Start), "INSERT")}) )
Dim acEd As Editor = acDoc.Editor
Dim acPSR As PromptSelectionResult
If SelectOnScreen Then
Dim opts As New PromptSelectionOptions()
opts.MessageForAdding = Prompt
If Filter Is Nothing Then acPSR = acEd.GetSelection(opts) Else acPSR = acEd.GetSelection(opts, Filter)
Else
If Filter Is Nothing Then acPSR = acEd.SelectAll() Else acPSR = acEd.SelectAll(Filter)
End If
If acPSR.Status = PromptStatus.OK Then Return New ObjectIdCollection(acPSR.Value.GetObjectIds()) Else Return New ObjectIdCollection()
End Function
Public Shared Function CloneBlock(ByVal SourceBlock As acObject, Optional ByVal ReplaceMe As Boolean = False) As ObjectId
SourceBlock.GetInformationFromDrawing()
Dim acObj As New acObject(InsertBlock(SourceBlock.InsertionPoint, SourceBlock.Name, SourceBlock.Xscale, SourceBlock.Yscale, SourceBlock.Zscale, SourceBlock.Layer, , True, SourceBlock.SpaceID))
If SourceBlock.HasMemoryValues Then
For i As Integer = 0 To SourceBlock.MemoryValueNames.Count - 1
acObj.acRefValue(SourceBlock.MemoryValueNames(i), True) = SourceBlock.MemoryValueSettings(i)
Next
End If
If SourceBlock.Name = "TitleBlock" Then
Try
acObj.SystemBlockVersion_acRefValue = "1.00"
Catch ex As Autodesk.AutoCAD.Runtime.Exception
End Try
Try
acObj.SystemBlockType_acRefValue = "brTitleBlock"
Catch ex As Autodesk.AutoCAD.Runtime.Exception
End Try
End If
If ReplaceMe Then SourceBlock.DeleteMyAcObject()
End Function
End Class
Public Class ThisDrawing
Public Shared Sub RedefineBlocks(ByVal BlockName As String, ByVal FromFile As String)
Try
Dim BlockList As ObjectIdCollection = ThisDrawing.GetAllBlockRefIDs(BlockName)
If Not BlockList Is Nothing Then
If BlockList.Count > 0 Then
ThisDrawing.DefineBlockFromFile(BlockName, FromFile, True)
For Each blkID As ObjectId In BlockList
Dim mObj As New acObject
mObj.acObjectID = blkID
Utilities.CloneBlock(mObj, True)
Next
End If
End If
Catch ex As Autodesk.AutoCAD.Runtime.Exception
End Try
End Sub
Public Shared Function GetAllBlockRefIDs(Optional ByVal BlockName As String = "<<Select All>>") As ObjectIdCollection
Return Utilities.GetAllBlockRefIDs(Application.DocumentManager.MdiActiveDocument, BlockName)
End Function
Public Shared Function DefineBlockFromFile(ByVal BlockName As String, ByVal FromFile As String, Optional ByVal Redefine As Boolean = False) As Boolean
If ThisDrawing.HasBlock(BlockName) And Not Redefine Then Return False
Dim acDm As DocumentCollection = Application.DocumentManager
Dim acEd As Editor = acDm.MdiActiveDocument.Editor
Dim DestDoc As Document = acDm.MdiActiveDocument
Dim DestDb As Database = DestDoc.Database
Dim sourceDb As New Database(False, True)
Dim ResultMsg As String = ""
Try
' Read the DWG into a side database
sourceDb.ReadDwgFile(FromFile, System.IO.FileShare.Read, True, "")
' Create a variable to store the list of block identifiers
Dim blockIds As New ObjectIdCollection()
Using SourceTM As Autodesk.AutoCAD.DatabaseServices.TransactionManager = sourceDb.TransactionManager
Using SourceTM.StartTransaction
Dim bt As BlockTable = DirectCast(SourceTM.GetObject(sourceDb.BlockTableId, OpenMode.ForRead, False), BlockTable)
' Check each block in the block table
blockIds.Add(FindMyBlockID(BlockName, bt, SourceTM))
End Using
End Using
' Copy blocks from source to destination database
If blockIds.Count > 0 Then
Dim mapping As New IdMapping()
Using DestDoc.LockDocument
sourceDb.WblockCloneObjects(blockIds, DestDb.BlockTableId, mapping, DuplicateRecordCloning.Replace, False)
End Using
End If
' ResultMsg = vbLf & "Copied block definitions from " + mBlockItem.FileName + " to the current drawing."
Catch ex As Autodesk.AutoCAD.Runtime.Exception
ResultMsg = vbLf & "Error during copy: " + ex.Message
End Try
sourceDb.Dispose()
'' Set the new document current (very important)
acDm.MdiActiveDocument = DestDoc
acEd.WriteMessage(ResultMsg)
Return True
End Function
Public Shared Function FindMyBlockID(ByVal BlockName As String, ByRef aBlockTable As BlockTable, ByVal Trans As Autodesk.AutoCAD.DatabaseServices.TransactionManager) As ObjectId
For Each btrId As ObjectId In aBlockTable
Dim btr As BlockTableRecord = DirectCast(Trans.GetObject(btrId, OpenMode.ForRead, False), BlockTableRecord)
' Only add named & non-layout blocks to the copy list
If Not btr.IsAnonymous AndAlso Not btr.IsLayout Then
If btr.Name = BlockName Then
Dim ObjID As ObjectId = btr.ObjectId
btr.Dispose()
Return ObjID
End If
End If
btr.Dispose()
Next
Return Nothing
End Function
Public Shared Function HasBlock(ByVal BlockName As String) As Boolean
Dim ReturnVal As Boolean = False
Dim acDoc As Autodesk.AutoCAD.ApplicationServices.Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
Dim acDB As Autodesk.AutoCAD.DatabaseServices.Database = acDoc.Database
Using acTrans As Autodesk.AutoCAD.DatabaseServices.Transaction = acDoc.TransactionManager.StartTransaction
Try
' Then open the block table and check the
' block definition exists
Dim bt As Autodesk.AutoCAD.DatabaseServices.BlockTable = _
DirectCast(acTrans.GetObject(acDB.BlockTableId, _
Autodesk.AutoCAD.DatabaseServices.OpenMode.ForRead), Autodesk.AutoCAD.DatabaseServices.BlockTable)
If bt.Has(BlockName) Then ReturnVal = True
Catch ex As Autodesk.AutoCAD.Runtime.Exception
End Try
acTrans.Commit()
End Using
Return ReturnVal
End Function
End Class
End Namespace
InsertBlock
Reply With Quote
