[ikambi]

Интересует как сделать Preview чертежа. На чертеже содержится блок.
Нужно не открывая файл с этим блоком в AutoCad, просмотреть его.
Вобщем то дублировать функцию которая используется в окне вставки блока. Там при выборе файла появляется превьюшка с его содержимым.
Все это должно быть реализовано на VBA

[Александр Ривилис]

На VBA у меня кода нет, а вот на C++ - запросто. На VBA можешь попробовать DwgThumbnail.ocx (я его не пробовал - гугл нашел его здесь: http://www.ocxdump.com/ocxfiles/D/DwgThumbnail.ocx, но возможно где-то есть более свежая версия).

[gomer]

А на лиспе через OpenDCL

[ikambi]

Не знаю лисп

DwgThumbnail.ocx тоже ни о чем не говорит

[Александр Ривилис]

Сообщение от ikambi DwgThumbnail.ocx тоже ни о чем не говорит

А о чем он тебе должен говорить? Размещаешь контрол на форме, передаешь ему имя файла и получаешь превьюшку.

[gomer]

Сообщение от Александр Ривилис Размещаешь контрол на форме, передаешь ему имя файла и получаешь превьюшку.

А перед этим регистрируешь библиотечку и размещаешь контрол на панели инструментов

[Александр Ривилис]

Здесь код на C#: http://www.theswamp.org/index.php?to...6189#msg366189 - можно получить preview даже без установленного AutoCAD.
Здесь на VB.NET: http://www.codeproject.com/KB/vbscri...Extractor.aspx - на VBA сам переделаешь

[Supermax]

Может кто выложит acThumbnailReader.zip?

[ikambi]

Вот файл который я нашел, только не пойму что с ним делать

[Александр Ривилис]

Сообщение от Supermax Может кто выложит acThumbnailReader.zip?

Лень регистрироваться? Там в архиве только один vb-файл:

Код:

[Выделить все]

Public Class acThumbnailReader

    Private Structure BITMAPINFOHEADER
        Dim biSize As Integer
        Dim biWidth As Integer
        Dim biHeight As Integer
        Dim biPlanes As Short
        Dim biBitCount As Short
        Dim biCompression As Integer
        Dim biSizeImage As Integer
        Dim biXPelsPerMeter As Integer
        Dim biYPelsPerMeter As Integer
        Dim biClrUsed As Integer
        Dim biClrImportant As Integer
    End Structure

    Private Structure RGBQUAD
        Dim rgbBlue As Byte
        Dim rgbGreen As Byte
        Dim rgbRed As Byte
        Dim rgbReserved As Byte
    End Structure

    Private Structure IMGREC
        Dim bytType As Byte
        Dim lngStart As Integer
        Dim lngLen As Integer
    End Structure

    Public Shared Function GetThumbnail(ByVal strFile As String, Optional ByVal boolRetainBackColor As Boolean = True, Optional ByVal boolSaveToFile As Boolean = False, Optional ByVal strSaveName As String = "") As Bitmap
        Dim bmp As New Bitmap(1, 1, System.Drawing.Imaging.PixelFormat.Format8bppIndexed)
        Dim bytCnt As Byte
        Dim bytBMPBuff() As Byte
        Dim lngImgLoc As Integer
        Dim lngFile As Integer
        Dim lngCurLoc As Integer
        Dim lngY As Integer
        Dim lngX As Integer
        Dim lngColor As Integer
        Dim lngCnt As Integer
        Dim intCnt As Short
        Dim udtRec As IMGREC
        Dim udtColors() As RGBQUAD
        Dim udtColor As RGBQUAD
        Dim udtHeader As BITMAPINFOHEADER
        Dim intRed As Short
        Dim intGreen As Short
        Dim intBlue As Short
        On Error GoTo Err_Control
        If Len(Dir(strFile)) > 0 Then
            lngFile = FreeFile()
            FileOpen(lngFile, strFile, OpenMode.Binary)
            Seek(lngFile, 14)
            FileGet(lngFile, lngImgLoc)
            Seek(lngFile, lngImgLoc + 17)
            lngCurLoc = Seek(lngFile)
            Seek(lngFile, lngCurLoc + 4)
            FileGet(lngFile, bytCnt)
            If bytCnt > 1 Then
                For intCnt = 1 To bytCnt
                    FileGet(lngFile, udtRec)
                    If udtRec.bytType = 2 Then
                        Seek(lngFile, udtRec.lngStart + 1)
                        FileGet(lngFile, udtHeader)
                        ReDim bytBMPBuff(udtRec.lngLen)
                        If udtHeader.biBitCount = 8 Then
                            ReDim udtColors(256)
                            FileGet(lngFile, udtColors)
                            Seek(lngFile, udtRec.lngStart)
                            FileGet(lngFile, bytBMPBuff)
                            bmp = New Bitmap(udtHeader.biWidth, udtHeader.biHeight)
                            For lngY = 1 To udtHeader.biHeight
                                For lngX = udtHeader.biWidth To 1 Step -1
                                    lngColor = bytBMPBuff(UBound(bytBMPBuff) - lngCnt)
                                    udtColor = udtColors(lngColor)
                                    intRed = CShort(udtColor.rgbRed)
                                    intGreen = CShort(udtColor.rgbGreen)
                                    intBlue = CShort(udtColor.rgbBlue)
                                    lngColor = RGB(intRed, intGreen, intBlue)
                                    If boolRetainBackColor = False Then
                                        If lngColor = Drawing.ColorTranslator.ToOle(Drawing.Color.Black) Then
                                            lngColor = Drawing.ColorTranslator.ToOle(Drawing.Color.White)
                                        ElseIf lngColor = Drawing.ColorTranslator.ToOle(Drawing.Color.White) Then
                                            lngColor = Drawing.ColorTranslator.ToOle(Drawing.Color.Black)
                                        End If
                                    End If
                                    bmp.SetPixel(lngX - 1, lngY - 1, Drawing.ColorTranslator.FromOle(lngColor))
                                    lngCnt = lngCnt + 1
                                Next lngX
                            Next lngY
                        End If
                        Exit For
                    ElseIf udtRec.bytType = 3 Then
                        Exit For
                    End If
                Next intCnt
            End If
        End If
Exit_Here:
        FileClose(lngFile)
        If boolSaveToFile = True Then
            If (strSaveName = "") Then
                Dim fName As String
                fName = IO.Path.GetTempPath & IO.Path.GetFileNameWithoutExtension(IO.Path.GetRandomFileName) & ".bmp"
                bmp.Save(fName)
            Else
                bmp.Save(strSaveName)
            End If
        End If
        Return bmp
        Exit Function
Err_Control:
        Select Case Err.Number
            Case Else
                MsgBox(Err.Description)
                Resume Exit_Here
        End Select
    End Function
End Class

[Supermax]

О! А сделать COM, в котором есть метод "незнамокакназывающийся", при запуске которого и передаче ему аргументом пути и имени файла када, получать путь и имя временного растрового файла?

[Александр Ривилис]

Сообщение от Supermax А сделать COM, в котором есть метод "незнамокакназывающийся", при запуске которого и передаче ему аргументом пути и имени файла када, получать путь и имя временного растрового файла?

Зачем? Для вызова из LISP? Для вызова из lisp можно переделать этот код для вызова как lisp-функции (мне лень). А вообще глянь сюда: http://maestrogroup.com.ua/support/SaveDwgPreview.zip Может это тебе поможет.

[ShaggyDoc]

Вот исходник моего компонента для Delphi для просмотра превьюва. Разумеется, не нужен ни сам AutoCAD, ни всякие OCX. Желающие могут переписать на любой другой язык - там все просто.

Код:

[Выделить все]

unit ruDwgPreview;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  ExtCtrls;

type
  TruDwgPreview = class(TImage)
  private
    { Private declarations }
    FFileName: string;
    procedure SetFileName(Value: string);
    procedure ImportDwgThumbnail(DWGFileName: string);
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    { Published declarations }
    property FileName: string read FFileName write SetFileName;
  end;

procedure Register;

implementation

constructor TruDwgPreview.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
end;

destructor TruDwgPreview.Destroy;
begin
  inherited Destroy;
end;

procedure TruDwgPreview.SetFileName(Value: string);
begin
  FFileName := Value;
  ImportDwgThumbnail(pchar(Value));
end;

procedure TruDwgPreview.ImportDwgThumbnail(DWGFileName: string);
const
  ImageSentinel: array[0..15] of Byte =
  ($1F, $25, $6D, $07, $D4, $36, $28, $28, $9D, $57, $CA, $3F, $9D, $44, $10,
    $2B);
type
  TDwgFileHeader = packed record
    Signature: array[0..5] of Char;
    Unused: array[0..6] of Char;
    ImageSeek: LongInt;
  end;
var
  DwgFile: file;
  StoreFileMode: Byte;
  DwgFileHeader: TDwgFileHeader;
  DwgSentinelData: array[0..15] of Byte;

  function LoadBMPData(const BitmapInfo: PBitmapInfo): Boolean;
  var
    BitmapHandle: HBITMAP;
    Bits: Pointer;
    NumColors: Integer;
    DC: HDC;

    function GetDInColors(BitCount: Word): Integer;
    begin
      case BitCount of
        1, 4, 8: Result := 1 shl BitCount;
      else
        Result := 0;
      end;
    end;

  begin
  inherited Picture.Bitmap.Dormant;//.FreeImage;
  inherited Update;
    Result := False;
    DC := GetDC(0);
    if DC = 0 then
      Exit; // out of resources?
    try
      with BitmapInfo^ do
      begin
        NumColors := GetDInColors(bmiHeader.biBitCount);
        Bits := Pointer(Longint(BitmapInfo) + SizeOf(bmiHeader) + NumColors *
          SizeOf(TRGBQuad));
      end;
      BitmapHandle := CreateDIBitmap(DC, BitmapInfo.bmiHeader, CBM_INIT, Bits,
        BitmapInfo^, DIB_RGB_COLORS);
      if BitmapHandle <> 0 then
      begin
         inherited Picture.Bitmap.Handle := BitmapHandle;
         inherited Show;
        Result := True;
      end;
    finally
      ReleaseDC(0, DC);
    end;
  end;


  procedure ProcessImageData;
  type
    TImageDataHeader = packed record
      TotalCount: LongInt;
      ImagesPresent: Byte;
    end;
    TImageDataRecord = packed record
      DataType: Byte;
      StartOfData: LongInt;
      SizeOfData: LongInt;
    end;
  var
    ImageHeader: TImageDataHeader;
    ImageRecord: TImageDataRecord;
    BMPData, WMFData: TImageDataRecord;
    ThumbData: Pointer;
  begin
    BlockRead(DwgFile, ImageHeader, SizeOf(ImageHeader));
    if ImageHeader.TotalCount + FilePos(DwgFile) > FileSize(DwgFile) then
      Exit;
    FillChar(BMPData, SizeOf(BMPData), 0);
    FillChar(WMFData, SizeOf(WMFData), 0);
    while (IOResult = 0) and (ImageHeader.ImagesPresent > 0) do
    begin
      BlockRead(DwgFile, ImageRecord, SizeOf(ImageRecord));
      if (IOResult <> 0) or (ImageRecord.StartOfData > FileSize(DwgFile)) then
        Break;
      case ImageRecord.DataType of
        2: BMPData := ImageRecord;
        3: WMFData := ImageRecord;
      end;
      Dec(ImageHeader.ImagesPresent);
    end;
    //  Не просматриваем  thumbnail в формате WMF, который был только в  R13
	 if BMPData.StartOfData > 0 then
      ImageRecord := BMPData
//    else if WMFData.StartOfData > 0 then
//      ImageRecord := WMFData
    else
      Exit;
    Seek(DwgFile, ImageRecord.StartOfData);
    GetMem(ThumbData, ImageRecord.SizeOfData);
    BlockRead(DwgFile, ThumbData^, ImageRecord.SizeOfData);
    try
  //    if ImageRecord.DataType = 2 then
        LoadBMPData(ThumbData);
  //    else
  //          ShowMessage('WMF Image for R13 not supported!');
    finally
      FreeMem(ThumbData);
    end;
  end;

begin
  Visible:=False;
  inherited hide;
  if (not FileExists (DWGFileName)) then Exit;
  StoreFileMode := FileMode;
  FileMode := 0; // read-only
  System.Assign(DwgFile, DWGFileName);
  Reset(DwgFile, 1);
  FileMode := StoreFileMode;
  if IOResult <> 0 then
    Exit;
  try
    BlockRead(DwgFile, DwgFileHeader, SizeOf(DwgFileHeader));
    if (IOResult = 0) and (Copy(DwgFileHeader.Signature, 1, 4) = 'AC10') and
      (DwgFileHeader.ImageSeek <= FileSize(DwgFile)) then
    begin
      Seek(DwgFile, DwgFileHeader.ImageSeek);
      BlockRead(DwgFile, DwgSentinelData, SizeOf(DwgSentinelData));
      if (IOResult = 0) and CompareMem(@DwgSentinelData, @ImageSentinel,
        SizeOf(DwgSentinelData)) then
        ProcessImageData;
    end;
  finally
    Close(DwgFile);
  end;
end;


procedure Register;
begin
  RegisterComponents('ruCAD', [TruDwgPreview]);
end;

end.

[АлексЮстасу]

По данным из этой темы (с помощью #7 и др.) можно сделать превью всего содержимого файла? Не так, как делает сам Автокад - не только той части, что отображена на экране?

[Александр Ривилис]

Нет.