SaveDocumentEx(W) сохраняет в 5-ю версию КОМПАСа не все файлы

[kosikov2006]

Как сделать так чтобы функция SaveDocumentEx(W) сохраняла в 5-ю версию КОМПАСа даже те файлы, которые содержат объекты, появившиеся в более новых версиях КОМПАСа.
При ручном сохранении таких файлов КОМПАС выводит окошко о том что будут преобразованы некоторые объекты. А функция SaveDocumentEx(W) не хочет сохранять такие файлы в 5-ю версию.

[Sabahs]

Можете прикрепить файл который не хочет сохраняться.

[kosikov2006]

Ну например этот файл

[Sabahs]

Можно попробовать перед вызовом функции SaveDocumentEx, установить свойство IApplication.HideMessage=ksHideMessageYes, после вернуть назад IApplication.HideMessage=ksShowMessage.
Сейчас проверил, тот файл что Вы прикрепили функция сохраняет, выдаёт запрос на преобразование и при подтверждении сохраняет, установите свойства, как я писал выше, то библиотека будет сама нажимать кнопку "Да" в запросе.

[kosikov2006]

У меня не получается.
Похоже я как-то не правильно обращаюсь к IApplication.

Код Выделить Развернуть


procedure  LIBRARYENTRY( comm : Word  );  pascal;
var
  Doc1 : Reference;
  folder: string;
  I: Integer;
  obj1 : TComponent;
  sr: TSearchRec;
  KOMPAS :IApplication;
begin
  folder := 'D:\Projects\';
  CreateDir(folder+'5\');

  KOMPAS:=GetActiveOleObject('Kompas.Application.7') as iApplication;

  KOMPAS.HideMessage:=ksHideMessageYes;
  if SysUtils.FindFirst(pchar(folder + '*.cdw'), faAnyFile, sr) = 0 then
  begin
    repeat
      Doc1 := OpenDocumentW(pchar(folder+sr.Name),0);
      SaveDocumentExW(Doc1,pchar(folder+'5\'+sr.Name),1);
      CloseDocument(Doc1);
    until SysUtils.FindNext(sr) <> 0;
    SysUtils.FindClose(sr);
  end;
  KOMPAS.HideMessage:=ksShowMessage;
end;


[Sabahs]

Набросал на скорую руку.
var
Disp:IDispatch;
KompasAPI:IApplication;
Doc1 : Reference;
folder: string;
sr: TSearchRec;
begin
  folder := 'D:\Projects\';
  CreateDir(folder+'5\');
  Disp:=IDispatch(CreateKompasApplication);
  KompasAPI:=Disp as IApplication;
  KompasAPI.HideMessage:=ksHideMessageYes;
  if SysUtils.FindFirst(pchar(folder + '*.cdw'), faAnyFile, sr) = 0 then
   begin
       repeat
       Doc1 := OpenDocumentW(pchar(folder+sr.Name),0);
       SaveDocumentExW(Doc1,pchar(folder+'5\'+sr.Name),1);
       CloseDocument(Doc1);
       until SysUtils.FindNext(sr) <> 0;
       SysUtils.FindClose(sr);
   end;
  KompasAPI.HideMessage:=ksShowMessage;
end;

[kosikov2006]

Извиняюсь за свою малую осведомленность. Это код для отдельного приложения, а не для плагина к компасу?
Я попробовал приложение сделать, вылезает ошибка при запуске приложения.

Код Выделить Развернуть


unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,

   LibTool, KsAPI7, ksConstTLB,
       kstlb, ComObj, ksAuto;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  Doc1 : Reference;
  folder: string;
  I: Integer;
  obj1 : TComponent;
  sr: TSearchRec;
  Disp:IDispatch;
  KompasAPI:IApplication;
  Document:IKompasDocument;
begin
  folder := 'D:\Projects\';
  CreateDir(folder+'5\');

  Disp:=IDispatch(CreateKompasApplication);
  KompasAPI:=Disp as IApplication;
  Document:=KompasAPI.ActiveDocument;
  if Document<>nil then
   begin
       KompasAPI.HideMessage:=ksHideMessageYes;
       if FindFirst(pchar(folder + '*.cdw'), faAnyFile, sr) = 0 then
        begin
          repeat
            Doc1 := OpenDocumentW(pchar(folder+sr.Name),0);
            SaveDocumentExW(Doc1,pchar(folder+'5\'+sr.Name),1);
            CloseDocument(Doc1);
          until FindNext(sr) <> 0;
            FindClose(sr);
        end;
       KompasAPI.HideMessage:=ksShowMessage;
    end;

end;

end.




А в плагин вставил (на основе примера Step1 из SDK) - никаких действий не происходит, но компас не зависает:

Код Выделить Развернуть


////////////////////////////////////////////////////////////////////////////////
//
// step11.pas - Самая простая библиотека на Delphi
//
////////////////////////////////////////////////////////////////////////////////
unit Step11;

interface
procedure  LIBRARYENTRY( comm: WORD  ); Pascal;
function   LIBRARYNAMEW : PChar;         Pascal;

implementation

uses  LibTool, Sysutils, Vcl.StdCtrls, Winapi.Windows, Winapi.Messages,
       System.Classes, Vcl.Forms, Vcl.Dialogs, Unit1, KsAPI7, ksConstTLB,
       kstlb, ComObj, ksAuto;

//----------------------------------------------------------------------------------------
// Головная функция библиотеки
//---
procedure  LIBRARYENTRY( comm : Word  );  pascal;
var
  Doc1 : Reference;
  folder: string;
  I: Integer;
  obj1 : TComponent;
  sr: TSearchRec;
  Disp:IDispatch;
  KompasAPI:IApplication;
  Document:IKompasDocument;
begin
  folder := 'D:\Projects\';
  CreateDir(folder+'5\');

  Disp:=IDispatch(CreateKompasApplication);
  KompasAPI:=Disp as IApplication;
  Document:=KompasAPI.ActiveDocument;
  if Document<>nil then
   begin
       KompasAPI.HideMessage:=ksHideMessageYes;
       if SysUtils.FindFirst(pchar(folder + '*.cdw'), faAnyFile, sr) = 0 then
        begin
          repeat
            Doc1 := OpenDocumentW(pchar(folder+sr.Name),0);
            SaveDocumentExW(Doc1,pchar(folder+'5\'+sr.Name),1);
            CloseDocument(Doc1);
          until SysUtils.FindNext(sr) <> 0;
            SysUtils.FindClose(sr);
        end;
       KompasAPI.HideMessage:=ksShowMessage;
    end;


end;

//----------------------------------------------------------------------------------------
// Имя библиотеки
//---
function LIBRARYNAMEW : PChar;  pascal;
begin
  Result:='Пакетный конвертер в 5-ю версию';
end;

end.


[Sabahs]

В верху я поправил.

[kosikov2006]

Всё равно не работает

[kosikov2006]

Прикладываю код.

[Sabahs]

У меня работает.

[kosikov2006]

Завтра выложу файлы которые у меня в папке. D:\Projects\

[Sabahs]

А зачем они мне?

[kosikov2006]

Я думаю в них всё дело, да там еще кроме компасовских другие файлы.и папки есть.
Завтра попробую всё лишнее убрать.

[Sabahs]

Так в коде проверку поставьте.

[kosikov2006]

Лень.
Если это всё из-за этих лишних файлов/папок, то мне будет проще пользователю сказать не совать в папку ничего лишнего, чем программировать проверку.

[Sabahs]

У Вас там уже проверка, есть, код не будет работать, если нет лицензии, в подтверждение видеоролик.
https://yadi.sk/i/g-TqlDE_WeZYT

[kosikov2006]

Лицензия стоит, с ней всё в порядке.

Может в моем компасе он автоматически жмет не "да", а "нет" (в диалоге преобразования объектов).
Компас 13 SP2

Про проверку я знаю, сам нашел эту часть кода в спраке delphi. Она должна работать нормально.

Полтергейст какой-то.

[kosikov2006]

Из всех этих файлов (прикрепил), в подпапке 5 появляются только 2 файла (показаны на картинке).

[Sabahs]

Вы не показали, из каких файлов?
Код работает.