vb.net 外部参照 unload 导致cad崩溃

glowz

 Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
        Dim doc As Document = Application.DocumentManager.MdiActiveDocument
        Dim db As Database = doc.Database
        ' Dim bt as
        '获取当前的选择集对象
        Dim acObjIdColl As ObjectIdCollection = New ObjectIdCollection()
        Dim ss As SelectionSet = ed.SelectImplied().Value
        Using trans As Transaction = db.TransactionManager.StartTransaction()
            '循环遍历选择集中的对象

            For Each id As ObjectId In ss.GetObjectIds()
                Dim obj As DBObject = trans.GetObject(id, OpenMode.ForRead)
                               If TypeOf (obj) Is BlockReference Then
                                       Dim br As BlockReference = trans.GetObject(id, OpenMode.ForRead) 'CType(obj, BlockReference)
                    Dim btr As BlockTableRecord = trans.GetObject(br.BlockTableRecord, OpenMode.ForRead)
                    If (btr.IsFromExternalReference) Then
                        Dim xrefId As ObjectId = br.BlockTableRecord
                        If (Not xrefId = ObjectId.Null) Then
                            acObjIdColl.Add(xrefId)
                            'db.DetachXref(xrefId)
                            'db.UnloadXrefs()
                            ed.WriteMessage(vbCrLf & "Xref:" & btr.Name & " Unload!")
                        End If
                        db.UnloadXrefs(acObjIdColl)
                        trans.Commit()
                    End If
                    End If
            Next
        End Using

glowz

运行到db.UnloadXrefs(acObjIdColl) 就崩溃了

雪山飞狐_lzh

其他的没仔细看，但这里应该在For循环外吧

                        db.UnloadXrefs(acObjIdColl)
                        trans.Commit()

glowz

我是想做个右键的快捷菜单 ，一般的选择后执行 我试了试没有问题 ，用在右键的快捷菜单就崩溃了

2. <CommandMethod("AddBlockRefMenu")> _
3. Public Sub AddBlockRefMenu()
4. '定义一个ContextMenuExtension对象，用于表示快捷菜单
5. Dim contextMenu As New ContextMenuExtension()
6. '对于对象级别的快捷菜单，不必设置菜单名
7. Dim miBlockUnload As New MenuItem("卸载")
8. AddHandler miBlockUnload.Click, AddressOf miBlockUnload_Click
10. contextMenu.MenuItems.Add(miBlockUnload)
11. Application.AddObjectContextMenuExtension(RXClass.GetClass(GetType(BlockReference)), contextMenu)
12. End Sub
13. Sub miBlockUnload_Click(ByVal sender As Object, ByVal e As EventArgs)
14. Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
15. Dim doc As Document = Application.DocumentManager.MdiActiveDocument
16. Dim db As Database = doc.Database
17. ' Dim bt as
18. '获取当前的选择集对象
19. Dim acObjIdColl As ObjectIdCollection = New ObjectIdCollection()
20. Dim ss As SelectionSet = ed.SelectImplied().Value
21. Using trans As Transaction = db.TransactionManager.StartTransaction()
22. '循环遍历选择集中的对象
24. For Each id As ObjectId In ss.GetObjectIds()
25. Dim obj As DBObject = trans.GetObject(id, OpenMode.ForRead)
26. '如果所选择的对象是
27. If TypeOf (obj) Is BlockReference Then
28. '获取所选择的对象
29. Dim br As BlockReference = trans.GetObject(id, OpenMode.ForRead) 'CType(obj, BlockReference)
30. Dim btr As BlockTableRecord = trans.GetObject(br.BlockTableRecord, OpenMode.ForRead)
31. If (btr.IsFromExternalReference) Then
32. Dim xrefId As ObjectId = br.BlockTableRecord
33. If (Not xrefId = ObjectId.Null) Then
34. acObjIdColl.Add(xrefId)
35. 'db.DetachXref(xrefId)
36. 'db.UnloadXrefs()
37. ' ed.WriteMessage(vbCrLf & "Xref:" & btr.Name & " Unload!")
38. End If
40. End If
41. End If
42. Next
43. db.UnloadXrefs(acObjIdColl)
44. trans.Commit()
45. End Using
46. End Sub
47. End Class

<CommandMethod("AddBlockRefMenu")> _ Public Sub AddBlockRefMenu() '定义一个ContextMenuExtension对象，用于表示快捷菜单 Dim contextMenu As New ContextMenuExtension() '对于对象级别的快捷菜单，不必设置菜单名 Dim miBlockUnload As New MenuItem("卸载") AddHandler miBlockUnload.Click, AddressOf miBlockUnload_Click contextMenu.MenuItems.Add(miBlockUnload) Application.AddObjectContextMenuExtension(RXClass.GetClass(GetType(BlockReference)), contextMenu) End Sub Sub miBlockUnload_Click(ByVal sender As Object, ByVal e As EventArgs) Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor Dim doc As Document = Application.DocumentManager.MdiActiveDocument Dim db As Database = doc.Database ' Dim bt as '获取当前的选择集对象 Dim acObjIdColl As ObjectIdCollection = New ObjectIdCollection() Dim ss As SelectionSet = ed.SelectImplied().Value Using trans As Transaction = db.TransactionManager.StartTransaction() '循环遍历选择集中的对象 For Each id As ObjectId In ss.GetObjectIds() Dim obj As DBObject = trans.GetObject(id, OpenMode.ForRead) '如果所选择的对象是 If TypeOf (obj) Is BlockReference Then '获取所选择的对象 Dim br As BlockReference = trans.GetObject(id, OpenMode.ForRead) 'CType(obj, BlockReference) Dim btr As BlockTableRecord = trans.GetObject(br.BlockTableRecord, OpenMode.ForRead) If (btr.IsFromExternalReference) Then Dim xrefId As ObjectId = br.BlockTableRecord If (Not xrefId = ObjectId.Null) Then acObjIdColl.Add(xrefId) 'db.DetachXref(xrefId) 'db.UnloadXrefs() ' ed.WriteMessage(vbCrLf & "Xref:" & btr.Name & " Unload!") End If End If End If Next db.UnloadXrefs(acObjIdColl) trans.Commit() End Using End Sub End Class

glowz

顺便再问问

2. Dim acTypValAr(0) As TypedValue
3. acTypValAr.SetValue(New TypedValue(DxfCode.Start, "BlockReference"), 0)

Dim acTypValAr(0) As TypedValue acTypValAr.SetValue(New TypedValue(DxfCode.Start, "BlockReference"), 0)

好像不能过滤到块参照，过滤块参照应该在.net怎么用呢

雪山飞狐_lzh

"Insert"

 

右键菜单的话，文档应该加锁的吧

glowz

谢谢 飞狐版主 能详细说下文档应该怎么加锁吗

雪山飞狐_lzh

Using doc.LockDocument()

 

 

End Using

glowz

谢谢 飞狐版主  可以做出来 哈哈

glowz

完整的代码