[编程交流] 检索AutoCAD块记录

Imports Autodesk.AutoCAD.Interop

 
Public Function GetDirectoryDrawings(directoryFullName As String, subDirsBrowse As Boolean) As List(Of FileInfo)
           Dim dir As New DirectoryInfo(directoryFullName)
           If Not dir.Exists Then
               Throw New DirectoryNotFoundException()
               Return Nothing
           End If
           Dim opt As SearchOption = SearchOption.AllDirectories
           If subDirsBrowse = False Then opt = SearchOption.TopDirectoryOnly
           Return dir.GetFiles("*dwg", opt).AsEnumerable().OrderBy(Function(x) x.FullName).ToList()
       End Function
       <CommandMethod("wtb", CommandFlags.Session)> _
       Public Sub testDirFiles()
           Dim folder As String = "C:\Test"
           Dim csvfile As String = "C:\Test\atable.csv"
           Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
           Dim db As Database = doc.Database
           Dim ed As Editor = doc.Editor
           Dim fd As List(Of FileInfo) = GetDirectoryDrawings(folder, False) ''     True for processing the subdirectories
           Dim collect As New StringBuilder
           If fd.Count = 0 Then Return
           Try
               Using doclock As DocumentLock = doc.LockDocument()
                   For n As Integer = 0 To fd.Count - 1
                       Dim dwgname As String = fd(n).FullName
                       Using newdb As Database = New Database(False, True)
                           ed.WriteMessage(vbLf + dwgname + vbLf)
                           Try
                               newdb.ReadDwgFile(dwgname, FileOpenMode.OpenForReadAndAllShare, False, Nothing)
                           Catch ex As Autodesk.AutoCAD.Runtime.Exception
                               If ex.ErrorStatus = ErrorStatus.DwgNeedsRecovery Then
                                   Continue For
                               End If
                           End Try
                           Using newtr As Transaction = newdb.TransactionManager.StartTransaction
                               ' Open dictionary for reading 
                               Dim layoutDict As DBDictionary = DirectCast(newtr.GetObject(newdb.LayoutDictionaryId, OpenMode.ForRead), DBDictionary)
                               ' Loop through dictionary entries
                               For Each entry As DictionaryEntry In layoutDict
                                   Dim ltr As Layout = DirectCast(newtr.GetObject(DirectCast(entry.Value, ObjectId), OpenMode.ForRead), Layout)
                                   Dim btr As BlockTableRecord = DirectCast(newtr.GetObject(ltr.BlockTableRecordId, OpenMode.ForRead), BlockTableRecord)
                                   For Each id As ObjectId In btr
                                       Dim obj As DBObject = DirectCast(newtr.GetObject(id, OpenMode.ForRead), DBObject)
                                       If TypeOf obj Is Table Then
                                           Dim tbl As Table = TryCast(obj, Table)
                                           If tbl IsNot Nothing Then
                                               collect.AppendLine(String.Format("---------------------------------------"))
                                               collect.AppendLine(String.Format("Drawing name: {0}", dwgname))
                                               collect.AppendLine(String.Format("Tab: {0}", ltr.LayoutName))
                                               Dim numrows As Integer = tbl.Rows.Count
                                               Dim numcols As Integer = tbl.Columns.Count
                                               For i As Integer = 0 To numrows - 1
                                                   Dim rowline As New List(Of String)
                                                   Dim line As String = String.Empty
                                                   For j = 0 To numcols - 1
                                                       Dim cel As Cell = tbl.Cells(i, j)
                                                       rowline.Add(cel.TextString)
                                                       line = line + cel.TextString + vbTab
                                                   Next
                                                   collect.AppendLine(line.TrimEnd(vbTab))
                                               Next
                                           End If
                                       End If
                                   Next
                               Next
                               newtr.Commit()
                           End Using
                       End Using
                   Next
               End Using
               WriteTableToFile(csvfile, collect)
           Catch ex As System.Exception
               ed.WriteMessage(vbLf + ex.ToString + vbLf)
           Finally
               ed.WriteMessage(vbLf + vbTab + "--->   File saved as: {0}   <---" + vbLf, csvfile)
           End Try
       End Sub
       Public Sub WriteTableToFile(fpath As String, data As StringBuilder)
           'If Not (File.Exists(fpath)) Then
           '    Using frs As New FileStream(fpath, FileMode.Create)
           '        frs.Flush()
           '    End Using
           'End If
           Using fs As New FileStream(fpath, FileMode.Append, FileAccess.Write)
               Using sw As New StreamWriter(fs, Encoding.ASCII)
                   sw.WriteLine(data.ToString)
               End Using
           End Using
       End Sub