Community
The firs onet gets the thumbnail of the layout you last saved in the drawing
The second gets all layout thumbnails
Will create a folder C:\AcadImages when netloaded and delete it when autocad closes
The thumbnail appeance depends on how your screen was when you last Saved
Another Idea is use ScreenCapture and around line 900 set
pofo.PreferCommandLine = true
So you can send directly to the command prompt I started to mess with it post what I have but it is not very useful
Imports Autodesk.AutoCAD Imports Autodesk.AutoCAD.ApplicationServices Imports Autodesk.AutoCAD.ApplicationServices.Application Imports Autodesk.AutoCAD.DatabaseServices Imports Autodesk.AutoCAD.EditorInput Imports Autodesk.AutoCAD.Geometry Imports Autodesk.AutoCAD.Runtime Imports Autodesk.AutoCAD.Windows Imports System.Drawing Imports System.IO Imports System.Threading Public Class Commands Implements IExtensionApplication <CommandMethod("DocumentThumbnail")> _ Public Sub DocumentThumbnail() Dim doc As Document = DocumentManager.MdiActiveDocument doc.Database.ThumbnailBitmap.Save("C:\AcadImages\Doc.Png", System.Drawing.Imaging.ImageFormat.Png) End Sub
<CommandMethod("AllLayoutsThumbnail")> _ Public Sub AllLayoutsThumbnail() Dim DB As Database = HostApplicationServices.WorkingDatabase Using trans As Transaction = DB.TransactionManager.StartTransaction Dim bt As BlockTable = DB.BlockTableId.GetObject(OpenMode.ForRead) For Each btrObjID As ObjectId In bt Dim btr As BlockTableRecord = btrObjID.GetObject(OpenMode.ForRead) If btr.IsLayout = True Then Dim lyt As Layout = btr.LayoutId.GetObject(OpenMode.ForRead) Dim btm As System.Drawing.Bitmap = lyt.Thumbnail btm.Save(String.Format("{0}\{1}.Gif", "C:\AcadImages", lyt.LayoutName, System.Drawing.Imaging.ImageFormat.Gif)) End If Next End Using End Sub
''' <summary> ''' This uses ScreenShot but you must REMOVESS if already loaded and add ''' pofo.PreferCommandLine = true and netload again around line 900 so msgbox does not pop up ''' It is buggy does not cause a exception but must hit return sometimes to make it work ''' Just started playing with it but I will post if anyway ''' </summary> ''' <remarks></remarks> <CommandMethod("UseScreenShot")> _ Public Sub UseScreenShot() Dim doc As Document = DocumentManager.MdiActiveDocument Try Dim DB As Database = HostApplicationServices.WorkingDatabase Using trans As Transaction = DB.TransactionManager.StartTransaction Dim bt As BlockTable = DB.BlockTableId.GetObject(OpenMode.ForRead) Dim btr As BlockTableRecord = doc.Database.CurrentSpaceId.GetObject(OpenMode.ForRead) If btr.IsLayout = True Then
Dim lyt As Layout = btr.LayoutId.GetObject(OpenMode.ForRead) Dim lmts As Extents2d = lyt.Limits Dim minPnt As String = lmts.MinPoint.ToString.Remove(lmts.MinPoint.ToString.Length - 1, 1) Dim maxPnt As String = lmts.MaxPoint.ToString.Remove(lmts.MaxPoint.ToString.Length - 1, 1) doc.SendStringToExecute( _ String.Format("{0}{1}{2}{3} ", "ScreenShot ", _ minPnt.Remove(0, 1) & vbCrLf, _ maxPnt.Remove(0, 1) & vbCrLf, "C:\AcadImages\Screenshot.Jpeg" & vbCrLf), _ True, False, False) End If End Using Catch ex As Exception MsgBox(ex.Message) End Try End Sub
Public Sub Initialize() Implements Autodesk.AutoCAD.Runtime.IExtensionApplication.Initialize If Not Directory.Exists("C:\AcadImages") Then Try Directory.CreateDirectory("C:\AcadImages") Catch ex As UnauthorizedAccessException MsgBox("Do Not Have Rights To Create Folder" & vbCrLf & _ "Change File Path And Reload") End Try End If End Sub
Public Sub Terminate() Implements Autodesk.AutoCAD.Runtime.IExtensionApplication.Terminate Directory.Delete("C:\AcadImages", True) End Sub
End Class