[编程交流] 在绘图中收集视口

Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.ApplicationServices
Public Class SampleCommands
   <CommandMethod("LVP")> _
   Public Sub LayoutVPs()
       Dim doc As Document = Application.DocumentManager.MdiActiveDocument
       Dim db As Database = doc.Database
       Dim ed As Editor = doc.Editor
       Dim layId As ObjectId
       Dim lo As Layout
       Dim loName As String
       Using trans As Transaction = db.TransactionManager.StartTransaction()
           Dim laydic As DBDictionary = DirectCast(trans.GetObject(db.LayoutDictionaryId, OpenMode.ForRead, False), DBDictionary)
           For Each dentry As DictionaryEntry In laydic
               layId = DirectCast(dentry.Value, ObjectId)
               lo = DirectCast(trans.GetObject(layId, OpenMode.ForRead), Layout)
               loName = lo.LayoutName
               If loName <> "Model" Then
                   ed.WriteMessage(vbLf & "Layout " & loName & " has " & CollectVieports(lo, doc).Count & " viewports.")
               End If
           Next
       End Using
   End Sub
   Function CollectVieports(ByRef lo As Layout, ByRef doc As Document) As ObjectIdCollection
       Dim db As Database = doc.Database
       Dim Btr As BlockTableRecord
       Dim vp As Viewport
       Dim oidcol As ObjectIdCollection = New ObjectIdCollection()
       Dim notpvp As Boolean 'don't include the general layout vp
       Using trans As Transaction = db.TransactionManager.StartTransaction()
           Btr = DirectCast(trans.GetObject(lo.BlockTableRecordId, OpenMode.ForRead), BlockTableRecord)
           For Each oid As ObjectId In Btr
               vp = TryCast(trans.GetObject(oid, OpenMode.ForRead), Viewport)
               If Not vp Is Nothing Then
                   If notpvp Then oidcol.Add(oid)
                   notpvp = True
               End If
           Next
       End Using
       Return oidcol
   End Function
End Class