Функция DrawCAD не выводит растровый объект

Форум для вопросов по библиотеке CAD DLL (CAD Image DLL, CAD Importer DLL)
Post Reply
AlexKalabukhov
Posts: 1
Joined: 18 May 2022, 18:21

Функция DrawCAD не выводит растровый объект

Post by AlexKalabukhov » 26 May 2022, 20:17

Здравствуйте!

Есть задача экспортировать чертёж из файла DWG в битмэп.
Экспериментирую на примере DemoDelphi.
Использую Delphi 2007.
Файл dwg с растровым объектом и несколькими полилиниями.
Выходной битмэп должен быть размера 5906x5906 пикселей.
Для отрисовки файла на битмэпе использую функцию DrawCAD.
В результате растровый объект не отрисовывается, в битмэп попадают только полилинии.
Если уменьшаю размер битмэпа, например до 590 пикселей, то функция отрабатывает как положено.

В пример добавил в главной форме пункт меню c таким обработчиком клика:

Code: Select all

procedure TfmMain.Export1Click(Sender: TObject);
const
  cnstBufSize = 1024;
var
  vFileName: string;
  vMsg: array[1..cnstBufSize] of WideChar;
  S: string;
  Ws: WideString;
  Bmp: TBitmap;
  Sz: Integer;
begin
  if (FCADFile = 0) or not SaveDialog.Execute then Exit;
  vTTFMode := 0;
  vFileName := SaveDialog.FileName;
  vFileName := ChangeFileExt(vFileName, '.bmp');
  vKoef := 1;
  Bmp := TBitmap.Create;
  try
    Bmp.PixelFormat := pf24bit;
    //Sz := 590;
    Sz := 5906;
    Bmp.SetSize(Sz, Sz);
    if DrawCAD(FCADFile, Bmp.Canvas.Handle, Rect(0, 0, Sz - 1, Sz - 1)) = 0 then
    begin
      GetLastErrorCAD(@vMsg[1], cnstBufSize);
      Ws := PWideChar(@vMsg[1]);
      S := string(Ws);
      Application.MessageBox(PChar(S), '', MB_OK);
    end;
    Bmp.SaveToFile(vFileName);
  finally
    Bmp.Free;
  end;
Подскажите, что я сделал неправильно.
Файл прилагаю.

Post Reply