外部导入一个块的问题

sayid · 发表于 2014-11-3 14:03

我看了好多帖子，也看到了Kean的那篇文章关于从外部文件导入块到当前打开的文件，但是他那个是全部导入，我现在就想导入那个外部文件中的一个。我想知道我现在这个代码有啥问题？求求大神指导下啊？

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim acDoc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
Dim destDB As Database = acDoc.Database
Dim acEditor As Editor = acDoc.Editor
Dim pPtRes As PromptPointResult
Dim pPtOpts As PromptPointOptions = New PromptPointOptions("")
pPtOpts.Message = vbLf & "点:"
pPtRes = acEditor.GetPoint(pPtOpts)
Dim InsertPt As Point3d = pPtRes.Value
If pPtRes.Status = PromptStatus.Cancel Then
Exit Sub
End If
Dim FilePath As String = "D:\2RD\PMDS\PMDS\Resources\PFD.dwg"
Dim FileName As String = " PFD.dwg"
Dim BlockName As String = "0920101"
Dim sourceDb As New Database(True, True)
sourceDb.ReadDwgFile(FilePath, System.IO.FileShare.Read, True, "")
Dim blockId As New ObjectIdCollection()
Using (acDoc.LockDocument)
Dim sourcetm As Autodesk.AutoCAD.DatabaseServices.TransactionManager = sourceDb.TransactionManager
Dim desttm As Autodesk.AutoCAD.DatabaseServices.TransactionManager = destDB.TransactionManager
Dim sourcemyT As Transaction = sourcetm.StartTransaction()
Dim sourcebt As BlockTable = DirectCast(sourcetm.GetObject(sourceDb.BlockTableId, OpenMode.ForRead, False), BlockTable)
For Each btrId As ObjectId In sourcebt
Dim sourcebtc As BlockTableRecord = DirectCast(sourcetm.GetObject((sourcebt(BlockTableRecord.ModelSpace)), OpenMode.ForRead, False), BlockTableRecord)
If sourcebtc.Name = BlockName Then
blockId.Add(btrId)
Dim mapping As New IdMapping()
sourceDb.WblockCloneObjects(blockId, destDB.BlockTableId, mapping, DuplicateRecordCloning.Replace, False)
Using destmyT As Transaction = desttm.StartTransaction()
Dim destbt As BlockTable = DirectCast(desttm.GetObject(destDB.BlockTableId, OpenMode.ForWrite, True), BlockTable)
Dim destbtc As BlockTableRecord = DirectCast(desttm.GetObject((destbt(BlockTableRecord.ModelSpace)), OpenMode.ForRead, False), BlockTableRecord)
Dim Block As BlockReference = New BlockReference(InsertPt, destbt(BlockName))
Block.ScaleFactors = New Scale3d(1, 1, 1)
Block.Rotation = 0
Dim ModelSpace As BlockTableRecord = desttm.GetObject(destDB.CurrentSpaceId, OpenMode.ForWrite)
ModelSpace.AppendEntity(Block)
destmyT.AddNewlyCreatedDBObject(Block, True)
destmyT.Commit()
End Using
ElseIf Not sourcebtc.IsAnonymous AndAlso Not sourcebtc.IsLayout Then
End If
sourcebtc.Dispose()
Next
Me.Close()
End Using
End Sub

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click 
        Dim acDoc As Document = Autodesk.<a href="http://bbs.mjtd.com/forum-41-1.html" target="_blank" class="relatedlink">AutoCAD</a>.ApplicationServices.Application.DocumentManager.MdiActiveDocument 
        Dim destDB As Database = acDoc.Database 
        Dim acEditor As Editor = acDoc.Editor 
        Dim pPtRes As PromptPointResult 
        Dim pPtOpts As PromptPointOptions = New PromptPointOptions("") 
 
        pPtOpts.Message = vbLf & "点:" 
        pPtRes = acEditor.GetPoint(pPtOpts) 
        Dim InsertPt As Point3d = pPtRes.Value 
 
        If pPtRes.Status = PromptStatus.Cancel Then 
            Exit Sub 
        End If 
 
        Dim FilePath As String = "D:\2RD\PMDS\PMDS\Resources\PFD.dwg" 
        Dim FileName As String = " PFD.dwg" 
        Dim BlockName As String = "0920101" 
        Dim sourceDb As New Database(True, True) 
        sourceDb.ReadDwgFile(FilePath, System.IO.FileShare.Read, True, "") 
        Dim blockId As New ObjectIdCollection() 
            Using (acDoc.LockDocument) 
                Dim sourcetm As Autodesk.AutoCAD.DatabaseServices.TransactionManager = sourceDb.TransactionManager 
                Dim desttm As Autodesk.AutoCAD.DatabaseServices.TransactionManager = destDB.TransactionManager 
 
                Dim sourcemyT As Transaction = sourcetm.StartTransaction() 
                Dim sourcebt As BlockTable = DirectCast(sourcetm.GetObject(sourceDb.BlockTableId, OpenMode.ForRead, False), BlockTable) 
 
                For Each btrId As ObjectId In sourcebt 
                    Dim sourcebtc As BlockTableRecord = DirectCast(sourcetm.GetObject((sourcebt(BlockTableRecord.ModelSpace)), OpenMode.ForRead, False), BlockTableRecord) 
                    If sourcebtc.Name = BlockName Then 
                        blockId.Add(btrId) 
                        Dim mapping As New IdMapping() 
                        sourceDb.WblockCloneObjects(blockId, destDB.BlockTableId, mapping, DuplicateRecordCloning.Replace, False) 
                        Using destmyT As Transaction = desttm.StartTransaction() 
                            Dim destbt As BlockTable = DirectCast(desttm.GetObject(destDB.BlockTableId, OpenMode.ForWrite, True), BlockTable) 
                            Dim destbtc As BlockTableRecord = DirectCast(desttm.GetObject((destbt(BlockTableRecord.ModelSpace)), OpenMode.ForRead, False), BlockTableRecord) 
                            Dim Block As BlockReference = New BlockReference(InsertPt, destbt(BlockName)) 
                            Block.ScaleFactors = New Scale3d(1, 1, 1) 
                            Block.Rotation = 0 
                            Dim ModelSpace As BlockTableRecord = desttm.GetObject(destDB.CurrentSpaceId, OpenMode.ForWrite) 
                            ModelSpace.AppendEntity(Block) 
                            destmyT.AddNewlyCreatedDBObject(Block, True) 
                            destmyT.Commit() 
                        End Using 
                    ElseIf Not sourcebtc.IsAnonymous AndAlso Not sourcebtc.IsLayout Then 
                             End If 
                    sourcebtc.Dispose() 
                Next 
                Me.Close() 
            End Using 
 
    End Sub

账号		自动登录	找回密码
密码			注册

[事件] 外部导入一个块的问题