Тема: Acad Drawing -> Image

Как создать image заданного размера из чертежа AutoCAD'a?

Re: Acad Drawing -> Image

> VadimR
Заданного размера не получится, можно
создать рисунок выделенных рамкой объектов
но к сожалению он будет пропорционален
размерам экрана. После этого нужна ручная
доводка напильником:

Option Explicit
Sub ExportWindowToImage()
Dim ptVarLow As Variant
Dim ptVarTop As Variant
' Работаем с активным документом
With ThisDrawing
ptVarLow = .Utility.GetPoint(, _
vbCrLf & "Specify first corner point: ")
ptVarTop = .Utility.GetCorner(ptVarLow, _
vbCrLf & "Specify other corner point: ")
' Сокращенное имя документа с расширением
Dim dwgName As String
dwgName = .Name
' Получаем имя документа без расширения
dwgName = Left$(dwgName, Len(dwgName) - 4)
'Удаляем все наборы из коллекции наборов документа
' если таковые были созданы ранее:
          With .SelectionSets
               While .Count > 0
                    .Item(0).Delete
               Wend
          End With
' Создаем пустой набор выбора и добавляем
' его в коллекцию наборов документа
Dim oSset As AcadSelectionSet
Set oSset = .SelectionSets.Add("$GooglyMoogly$")
'  Выбираем нужные объекты на экране рамкой
oSset.Select acSelectionSetWindow, ptVarLow, ptVarTop
' Задаем имя папки куда экспортируем файл
' (наклонный слэш на конце имени)
Dim folderName As String
folderName = "C:\MyVBA\"
' Задаем имя файла для экспорта без расширения
' (без наклонного слэша)
Dim targName As String
targName = folderName & dwgName
' Задаем расширениe файла (BMP, WMF, SAT - см. Help)
Dim extStr As String
extStr = "BMP"
' Непосредственно экспорт файла
.Export targName, extStr, oSset
' Удаляем набор выбора из документа
' (это действие не удаляет объекты на экране)
oSset.Delete
' Удаляем ссылку на переменную 'oSset'
Set oSset = Nothing
' Завершаем работу с документом
End With
End Sub

~'J'~