I hope that this can help
Imports AcDb = Autodesk.AutoCAD.DatabaseServices
Imports AcGe = Autodesk.AutoCAD.Geometry
' Import a block from a external drawing
Shared Function ImportBlock(ByVal FileName As String, _
ByVal blockname As String, _
Optional ByVal silent As Boolean = True) As AcDb.ObjectId
Dim id As AcDb.ObjectId = BlockNameToID(blockname)
If id <> Nothing Then Return id
If Not File.Exists(FileName) Then
If Not silent Then MsgBox("File not found: " & FileName)
Return Nothing
End If
Using db As AcDb.Database = New AcDb.Database
db.ReadDwgFile(FileName, FileShare.ReadWrite, True, "")
Using tr As AcDb.Transaction =
db.TransactionManager.StartTransaction
Using tbl As AcDb.BlockTable =
CType(tr.GetObject(db.BlockTableId, AcDb.OpenMode.ForRead),
AcDb.BlockTable)
If tbl.Has(blockname) Then
id = tbl(blockname)
Dim blk As AcDb.BlockTableRecord = _
CType(db.TransactionManager.GetObject(id,
AcDb.OpenMode.ForRead, False), AcDb.BlockTableRecord)
Dim col As AcDb.ObjectIdCollection = New
AcDb.ObjectIdCollection(New AcDb.ObjectId() {blk.ObjectId})
db.Wblock(AcDb.HostApplicationServices.WorkingDatabase(),
col, New AcGe.Point3d(0, 0, 0), AcDb.DuplicateRecordCloning.Ignore)
tr.Commit()
Else
If Not silent Then MsgBox("Block not found: " &
blockname)
Return Nothing
End If
End Using
End Using
db.CloseInput(True)
End Using
Return BlockNameToID(blockname)
End Function
Shared Function BlockNameToID(ByVal BlockName As String) As
AcDb.ObjectId
Dim tbl As AcDb.BlockTable = GetBlockTableForRead
If tbl.Has(BlockName) Then
Return tbl.Item(BlockName)
End If
Return Nothing
End Function
Shared Function GetBlockTableForRead() As AcDb.BlockTable
Using db As AcDb.Database =
AcDb.HostApplicationServices.WorkingDatabase()
Using tr As AcDb.Transaction =
db.TransactionManager.StartTransaction
Try
Return CType(tr.GetObject(db.BlockTableId,
AcDb.OpenMode.ForRead, False), AcDb.BlockTable)
Catch ex As Exception
End Try
End Using
End Using
Return Nothing
End Function
' Insert an external drawing as a block
Shared Sub InsertDrawing(ByVal dwgName As String, ByVal insPt As
AcGe.Point3d, _
ByVal s3d As AcGe.Scale3d, ByVal rot As Double)
Dim blkName As String = Path.GetFileNameWithoutExtension(dwgName)
Using db As AcDb.Database =
AcDb.HostApplicationServices.WorkingDatabase()
Using tr As AcDb.Transaction =
db.TransactionManager.StartTransaction
Try
Dim id As AcDb.ObjectId = Nothing
Using bt As AcDb.BlockTable =
tr.GetObject(db.BlockTableId, AcDb.OpenMode.ForRead, True)
If Not bt.Has(blkName) Then
Using sourceDb As AcDb.Database = New
AcDb.Database(False, False)
sourceDb.ReadDwgFile(dwgName, FileShare.Read,
True, "")
id = db.Insert(dwgName, sourceDb, False)
Dim blk As AcDb.BlockTableRecord =
tr.GetObject(id, AcDb.OpenMode.ForWrite, False, True)
blk.Name = blkName
End Using
Else
id = bt.Item(blkName)
End If
End Using
Dim btr As AcDb.BlockTableRecord =
tr.GetObject(db.CurrentSpaceId, AcDb.OpenMode.ForWrite, True)
Dim bref As AcDb.BlockReference = New
AcDb.BlockReference(insPt, id)
bref.ScaleFactors = s3d
bref.Rotation = rot
tr.AddNewlyCreatedDBObject(bref, True)
bref.Dispose()
btr.Dispose()
tr.Commit()
Catch ex As Exception
MsgBox(ex.ToString)
End Try
End Using
End Using
End Function
tp
I'm protected by SpamBrave
http://www.spambrave.com/
