如何复制一个打开的图形文件，我的出错了

lindunling

1. <CommandMethod("CreateTkMap")> Public Sub CreateTkMap()
   
2.         Dim acObjIdColl As ObjectIdCollection = New ObjectIdCollection()
   
3. 
   
4.         Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
   
5.         Dim acCurDb As Database = acDoc.Database
   
6. 
   
7.         Dim acDocEd As Editor = Application.DocumentManager.MdiActiveDocument.Editor
   
8.         Dim acSSPrompt As PromptSelectionResult
   
9.         acSSPrompt = acDocEd.SelectAll()
   
10. 
    
11.         If acSSPrompt.Status = PromptStatus.OK Then
    
12.             Dim acSSet As SelectionSet = acSSPrompt.Value
    
13.             For Each acSSObj As SelectedObject In acSSet
    
14.                 acObjIdColl.Add(acSSObj.ObjectId)
    
15.             Next   
    
16.         Else
    
17.             Application.ShowAlertDialog("活动文档无内容或复杂过程出现错误！")
    
18.             Exit Sub ' 退出
    
19.         End If
    
20. 
    
21.         Dim sLocalRoot As String = Application.GetSystemVariable("LOCALROOTPREFIX")
    
22.         Dim sTemplatePath As String = sLocalRoot + "Template\acad.dwt"
    
23.         Dim acDocMgr As DocumentCollection = Application.DocumentManager
    
24. 
    
25.         Dim acNewDoc As Document = acDocMgr.Add(sTemplatePath)
    
26.         Dim acDbNewDoc As Database = acNewDoc.Database
    
27. 
    
28.         Using acLckDoc As DocumentLock = acNewDoc.LockDocument()
    
29.             Using acTrans = acDbNewDoc.TransactionManager.StartTransaction()
    
30.                 Dim acBlkTblNewDoc As BlockTable
    
31.                 acBlkTblNewDoc = acTrans.GetObject(acDbNewDoc.BlockTableId, OpenMode.ForWrite)
    
32.                 Dim acBlkTblRecNewDoc As BlockTableRecord
    
33.                 acBlkTblRecNewDoc = acTrans.GetObject(acBlkTblNewDoc(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
    
34. 
    
35.                 Dim acIdMap As IdMapping = New IdMapping()
    
36.                 '  acIdMap.DestinationDatabase = acCurDb
    
37. 
    
38.                 acDocMgr.MdiActiveDocument = acNewDoc
    
39.                 acCurDb.WblockCloneObjects(acObjIdColl, acBlkTblRecNewDoc.ObjectId, acIdMap, DuplicateRecordCloning.Replace, False)
    
40. 
    
41.                 acTrans.Commit()
    
42.             End Using
    
43.         End Using
    
44.         'acDocMgr.MdiActiveDocument = acNewDoc
    
45. 
    
46.         '  对新图形文件继续操作出问题 如双击图形  
    
47. 
    
48.     End Sub

<CommandMethod("CreateTkMap")> Public Sub CreateTkMap()<br />         Dim acObjIdColl As ObjectIdCollection = New ObjectIdCollection()<br /> <br />         Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument<br />         Dim acCurDb As Database = acDoc.Database<br /> <br />         Dim acDocEd As Editor = Application.DocumentManager.MdiActiveDocument.Editor<br />         Dim acSSPrompt As PromptSelectionResult<br />         acSSPrompt = acDocEd.SelectAll()<br /> <br />         If acSSPrompt.Status = PromptStatus.OK Then<br />             Dim acSSet As SelectionSet = acSSPrompt.Value<br />             For Each acSSObj As SelectedObject In acSSet<br />                 acObjIdColl.Add(acSSObj.ObjectId)<br />             Next    <br />         Else<br />             Application.ShowAlertDialog("活动文档无内容或复杂过程出现错误！")<br />             Exit Sub ' 退出<br />         End If<br /> <br />         Dim sLocalRoot As String = Application.GetSystemVariable("LOCALROOTPREFIX")<br />         Dim sTemplatePath As String = sLocalRoot + "Template\acad.dwt"<br />         Dim acDocMgr As DocumentCollection = Application.DocumentManager<br /> <br />         Dim acNewDoc As Document = acDocMgr.Add(sTemplatePath)<br />         Dim acDbNewDoc As Database = acNewDoc.Database<br /> <br />         Using acLckDoc As DocumentLock = acNewDoc.LockDocument()<br />             Using acTrans = acDbNewDoc.TransactionManager.StartTransaction()<br />                 Dim acBlkTblNewDoc As BlockTable<br />                 acBlkTblNewDoc = acTrans.GetObject(acDbNewDoc.BlockTableId, OpenMode.ForWrite)<br />                 Dim acBlkTblRecNewDoc As BlockTableRecord<br />                 acBlkTblRecNewDoc = acTrans.GetObject(acBlkTblNewDoc(BlockTableRecord.ModelSpace), OpenMode.ForWrite)<br /> <br />                 Dim acIdMap As IdMapping = New IdMapping()<br />                 '  acIdMap.DestinationDatabase = acCurDb<br /> <br />                 acDocMgr.MdiActiveDocument = acNewDoc<br />                 acCurDb.WblockCloneObjects(acObjIdColl, acBlkTblRecNewDoc.ObjectId, acIdMap, DuplicateRecordCloning.Replace, False)<br /> <br />                 acTrans.Commit()<br />             End Using<br />         End Using<br />         'acDocMgr.MdiActiveDocument = acNewDoc<br /> <br />         '  对新图形文件继续操作出问题 如双击图形  <br /> <br />     End Sub

lindunling

我是想把一个打开的图形文件复制一份，然后在复制的文件上进行进一步的操作。
如果执行下面的命令是没有问题的，保存的图形也是没有问题的
acNewDoc.CloseAndSave("c:\fft.dwg")  ' 关闭 保存

但是我要执行别的操作，如缩放，程序崩溃了。
大家能不能帮我找找问题所在

秋天的飓风

换一个版本呢

lindunling

秋天的飓风 发表于 2012-2-29 10:50
换一个版本呢

画一些简单的线条 再执行这个命令 程序没有什么问题
再用一下工程图执行这个命令 就出现问题了
我想是不是拷贝过程，没有收尾的操作
应该不是版本问题