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

外部导入一个块的问题

我看了好多帖子,也看到了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
页: [1]
查看完整版本: 外部导入一个块的问题