Delphi открытие модели 3D проверка

OnePointer · 15.03.15, 15:29:12

Здравствуйте в этом коде я открываю свою 3D модель и заменяю размеры на другие
Как сделать проверку
1) Открыт ли компас 3Д , если не открыт не открывать его
2) Открыта ли данная деталь уже ,если открыта просто поменять рамеры, если не открыта то открыть и поменять размеры
спасибо

procedure TForm1.Button1Click(Sender: TObject);
begin
detail001r1 := ('C:\Users\Илья\Desktop\проба 3\1-1.m3d');
kompas:=KompasObject(CreateOleObject('Kompas.Application.5'));
//Получаем интерфейс документа-модели
Document3D:=ksDocument3D(kompas.Document3D());
//Открываем документ-модель
Document3D.Open(detail001r1,FALSE); //узазатель ссылка
//Делаем КОМПАС видимым
kompas.Visible:=true;
//Получаем интерфейс компонента
Part:= ksPart(Document3D.GetPart(pTop_Part));
//Получаем массив переменных модели
VariableCollection:=ksVariableCollection(Part.VariableCollection());
//Изменяем значение первой переменной
Variable:=ksVariable(VariableCollection.GetByName('vzD',TRUE,TRUE));
Variable.value:=vzD;
//Изменяем значение второй переменной
Variable:=ksVariable(VariableCollection.GetByName('vzD1',TRUE,TRUE));
Variable.value:=vzD1;

Variable:=ksVariable(VariableCollection.GetByName('vzD2',TRUE,TRUE));
Variable.value:=vzD2;

Variable:=ksVariable(VariableCollection.GetByName('vzD3',TRUE,TRUE));
Variable.value:=vzD3;

Variable:=ksVariable(VariableCollection.GetByName('vzL',TRUE,TRUE));
Variable.value:=vzL;

Variable:=ksVariable(VariableCollection.GetByName('vzP',TRUE,TRUE));
Variable.value:=vzP;

Variable:=ksVariable(VariableCollection.GetByName('vzR',TRUE,TRUE));
Variable.value:=vzR;

Variable:=ksVariable(VariableCollection.GetByName('vzR1',TRUE,TRUE));
Variable.value:=vzR1;

Variable:=ksVariable(VariableCollection.GetByName('valpha',TRUE,TRUE));
Variable.value:=valpha;

Variable:=ksVariable(VariableCollection.GetByName('vd',TRUE,TRUE));
Variable.value:=vd;

Variable:=ksVariable(VariableCollection.GetByName('vd1',TRUE,TRUE));
Variable.value:=vd1;

Variable:=ksVariable(VariableCollection.GetByName('vd2',TRUE,TRUE));
Variable.value:=vd2;

Variable:=ksVariable(VariableCollection.GetByName('vd3',TRUE,TRUE));
Variable.value:=vd3;

Variable:=ksVariable(VariableCollection.GetByName('vf',TRUE,TRUE));
Variable.value:=vf;

Variable:=ksVariable(VariableCollection.GetByName('vl',TRUE,TRUE));
Variable.value:=vl;

Variable:=ksVariable(VariableCollection.GetByName('vl1',TRUE,TRUE));
Variable.value:=vl1;

Variable:=ksVariable(VariableCollection.GetByName('vl2',TRUE,TRUE));
Variable.value:=vl2;

Variable:=ksVariable(VariableCollection.GetByName('vzS',TRUE,TRUE));
Variable.value:=vzS;
//Перестраиваем модель
Part.RebuildModel();
//Перерисовываем документ
Document3D.RebuildDocument();
//Устанавливаем полутоновое отображение модели
Document3D.drawMode:=vm_Shaded;
//Включаем отображение каркаса
Document3D.shadedWireframe:=TRUE;
end;

Sabahs · 16.03.15, 07:22:12

1. Пробуете сначала загрузить активный Компас
KompasObj:=KompasObject(GetActiveOleObject('Kompas.Application.5'));
если KompasObj=nil, то запускаете Компас
KompasObj:=KompasObject(CreateOleObject('Kompas.Application.5'));
2. Компас по идее сам эту проверку делает и не должен загрузить две детали.

Djunce · 26.04.22, 13:51:50

Когда программа закрыта, GetActiveOleObject выдает ошибку EOleSysError with message "Операция недоступна".
Решается конструкцией try...except.
Во втором пункте, если раскомментировать //showmessage(Document3D.fileName);
и оставить только
Document3D:=ksDocument3D(kompas.Document3D());
Document3D.Open(filepath,FALSE);
, то если документ уже открыт, переменная не загружается.
Если найти интерфейс открытого документа, то все работает нормально.

Код Выделить

procedure TForm1.Button1Click(Sender: TObject);
var
kompas: KompasObject;
Document3D: ksDocument3D;
iter: ksIterator;
objPtr, objPtr2: long;
pDisp: IDispatch;
filepath: string;
Begin
 filepath := 'C:\file.m3d';
 try
  //Подключаемся к КОМПАСу
  {$IFDEF __LIGHT_VERSION__}
    kompas:= KompasObject( GetActiveOleObject('KompasLT.Application.5') );
  {$ELSE}
    kompas:= KompasObject( GetActiveOleObject('Kompas.Application.5') );
  {$ENDIF}

  iter := ksIterator( kompas.GetIterator() ); // Инициализируем итератор
  iter.ksCreateIterator(D3_DOCUMENT_OBJ,0); // Обозначаем как документ-модель
  objPtr := iter.ksMoveIterator( 'F' ); // Находим первый
  objPtr2 := -1;
  while (objPtr<>0) do // Перечисляем все открытые документы
  begin
  pDisp:=ksDocument3D(kompas.ksGet3dDocumentFromRef(objPtr));

  if (pDisp<>nil) then
  begin
    Document3D:=ksDocument3D(pDisp);
    // showmessage(Document3D.fileName);
    // Если путь к существующему документу совпадает с тем который нужно открыть
    if (Document3D.fileName=filepath) then
    begin
    objPtr2 := objPtr;
    break;
    end;
  end;
  objPtr := iter.ksMoveIterator( 'N' ); // Находим следующий
  end;

  if (objPtr2>-1) then // Если такой документ уже открыт
  begin
  Document3D:=ksDocument3D(kompas.ksGet3dDocumentFromRef(objPtr2));
  end
  else // Если документ не найден, открываем деталь
  begin
  Document3D:=ksDocument3D(kompas.Document3D());
  Document3D.Open(filepath,FALSE);
  end;
  iter.ksDeleteIterator();

  //showmessage(Document3D.fileName);
 except // Если выдает ошибку

  kompas:=KompasObject(CreateOleObject('Kompas.Application.5'));

  //Получаем интерфейс документа-модели
  Document3D:=ksDocument3D(kompas.Document3D());
  //Открываем деталь
  Document3D.Open(filepath,FALSE);
 end;
 kompas.Visible := true;
end;

graphdark · 30.04.22, 15:06:43

Цитата: Djunce от 26.04.22, 13:51:50Когда программа закрыта, GetActiveOleObject выдает ошибку EOleSysError with message "Операция недоступна".
Решается конструкцией try...except.

У вас блок try должен получить только переменную kompas, проверка на нил и дальше по списку. Сейчас вы в try делаете все почти.

Djunce · 13.05.22, 15:13:26

Да, много лишнего, редко пользуюсь данной конструкцией, даже как-то не придавал этому значение.

Код Выделить

procedure TForm1.Button1Click(Sender: TObject);
var
kompas: KompasObject;
Document3D: ksDocument3D;
iter: ksIterator;
objPtr, objPtr2: long;
pDisp: IDispatch;
filepath: string;
active_program: boolean;
Begin
 active_program := true;
 filepath := 'C:\file.m3d';
 try
  //Подключаемся к КОМПАСу
  {$IFDEF __LIGHT_VERSION__}
    kompas:= KompasObject( GetActiveOleObject('KompasLT.Application.5') );
  {$ELSE}
    kompas:= KompasObject( GetActiveOleObject('Kompas.Application.5') );
  {$ENDIF}
 except // Если выдает ошибку
  active_program := false;
  kompas:=KompasObject(CreateOleObject('Kompas.Application.5'));
 end;

 if (active_program = true) then
 begin
  iter := ksIterator( kompas.GetIterator() ); // Инициализируем итератор
  iter.ksCreateIterator(D3_DOCUMENT_OBJ,0); // Обозначаем как документ-модель
  objPtr := iter.ksMoveIterator( 'F' ); // Находим первый
  objPtr2 := -1;
  while (objPtr<>0) do // Перечисляем все открытые документы
  begin
  pDisp:=ksDocument3D(kompas.ksGet3dDocumentFromRef(objPtr));

  if (pDisp<>nil) then
  begin
    Document3D:=ksDocument3D(pDisp);
    // showmessage(Document3D.fileName);
    // Если путь к существующему документу совпадает с тем который нужно открыть
    if (Document3D.fileName=filepath) then
    begin
    objPtr2 := objPtr;
    break;
    end;
  end;
  objPtr := iter.ksMoveIterator( 'N' ); // Находим следующий
  end;

  if (objPtr2>-1) then // Если такой документ уже открыт
  begin
  Document3D:=ksDocument3D(kompas.ksGet3dDocumentFromRef(objPtr2));
  end
  else // Если документ не найден, открываем деталь
  begin
  Document3D:=ksDocument3D(kompas.Document3D());
  Document3D.Open(filepath,FALSE);
  end;
  iter.ksDeleteIterator();

  //showmessage(Document3D.fileName);
 end
 else
 begin
  //Получаем интерфейс документа-модели
  Document3D:=ksDocument3D(kompas.Document3D());
  //Открываем деталь
  Document3D.Open(filepath,FALSE);
 end;

 kompas.Visible := true;
end;

Teywl Wind · 20.12.24, 20:17:06

Здравствуйте. Не стал плодить похожие темы, простите что поднимаю старую.
Подскажите, почему программа может не видеть и не подключаться к открытому компасу?

Выдает ошибку "Project Project.exe raised exception class EOleSysError with message 'Операция недоступна'."

Если же в разделе except сделать создание нового подключения, то создается второе окно компаса, где программа уже работает корректно.

Код Выделить

try
    //Подключаемся к КОМПАСу
    {$IFDEF __LIGHT_VERSION__}
      kompas:= KompasObject( GetActiveOleObject('KompasLT.Application.5') );
    {$ELSE}
      kompas:= KompasObject( GetActiveOleObject('Kompas.Application.5') );
    {$ENDIF}


   except // Если выдает ошибку
    if kompas = nil then ShowMessage('Компас не запущен!');
//    kompas:=KompasObject(CreateOleObject('Kompas.Application.5'));
   end;

UU · 20.12.24, 20:59:41

Что тут было непонятно написано?

Цитата: Sabahs от 16.03.15, 07:22:121. Пробуете сначала загрузить активный Компас
KompasObj:=KompasObject(GetActiveOleObject('Kompas.Application.5'));
если KompasObj=nil, то запускаете Компас
KompasObj:=KompasObject(CreateOleObject('Kompas.Application.5'));
2. Компас по идее сам эту проверку делает и не должен загрузить две детали.

Сейчас, Ваша конструкция устарела.
kompas:=KompasObject(GetActiveOleObject('Kompas.Application.5'));

Teywl Wind · 20.12.24, 21:08:31

Цитата: UU от 20.12.24, 20:59:41Что тут было непонятно написано?Сейчас, Ваша конструкция устарела.
kompas:=KompasObject(GetActiveOleObject('Kompas.Application.5'));

Все было предельно понятно.Я на эти сообщения и ориентировался при написании. Только даже с такой конструкцией, независимо, включен был компас заранее или нет, всегда открывается новая копия Компас.

UU · 20.12.24, 21:40:09

Цитата: Teywl Wind от 20.12.24, 21:08:31Все было предельно понятно.Я на эти сообщения и ориентировался при написании. Только даже с такой конструкцией, независимо, включен был компас заранее или нет, всегда открывается новая копия Компас.

Нужно было так писать

Код Выделить

try
//Подключаемся к КОМПАСу
  {$IFDEF __LIGHT_VERSION__}
  kompas:=KompasObject(GetActiveOleObject('KompasLT.Application.5'));
  {$ELSE}
  kompas:=KompasObject(GetActiveOleObject('Kompas.Application.5'));
  {$ENDIF}
except // Если выдает ошибку
  if kompas=nil then
  begin
    ShowMessage('Компас не запущен!');
    kompas:=KompasObject(CreateOleObject('Kompas.Application.5'));
  end;
end;

Но сейчас всё работает без деления на учебные, домашние и профессиональные версии, просто в примеры при выпуске новых версий, никто из создателей КОМПАС-3D не вникает.
Просто берётся тот Компас который зарегистрирован, стоять может несколько, но зарегистрирован всегда один.

Код Выделить

kompas:=KompasObject(GetActiveOleObject('Kompas.Application.5'));
if kompas=nil then
 begin
   ShowMessage('Компас не запущен!');
   kompas:=KompasObject(CreateOleObject('Kompas.Application.5'));
 end;

Teywl Wind · 20.12.24, 22:00:35

Спасибо. Я понял, что сейчас записывается короче. Но моя проблема была в том, что не видит запущенный компас. Поиск по форуму во всех темах выдает одинаковую запись подключения к уже запущенному компасу. Может я что то упускаю?

UU · 20.12.24, 22:02:11

Сейчас подключается?

Teywl Wind · 20.12.24, 22:14:02

Нет. Если просто вашу конструкцию вставить без try .. except, то просто выдает ошибку EOleSysError, а если через try .. except, но все остальное, как вы сказали - то запускает новое окно. В любом случае спасибо за помощь. Возможно лучше подумаю о библиотеке, а не об оконном приложении.

UU · 20.12.24, 22:17:20

Цитата: Teywl Wind от 20.12.24, 22:14:02Нет. Если просто вашу конструкцию вставить без try .. except, то просто выдает ошибку OleObject, а если через try .. except, но все остальное, как вы сказали - то запускает новое окно. В любом случае спасибо за помощь. Возможно лучше подумаю о библиотеке, а не об оконном приложении.

Как вариант можно запустить Компас от администратора для регистрации KOMPAS.Exe -register.
Для восстановления и исправления ошибок в реестре.

Teywl Wind · 20.12.24, 22:19:59

Цитата: UU от 20.12.24, 22:17:20Как вариант можно запустить Компас от администратора для регистрации KOMPAS.Exe -register.

Да! Это решило проблему. Большое Вам спасибо! А вы не знаете, почему так происходит?

UU · 20.12.24, 22:21:41

Исправляет битые ветки реестра и подтягивает именно тот Компас, который Вы пытаетесь использовать.

Форум пользователей ПО АСКОН

Новости:

Delphi открытие модели 3D проверка

OnePointer

Sabahs

Djunce

graphdark

Djunce

Teywl Wind

UU

Teywl Wind

UU

Teywl Wind

UU

Teywl Wind

UU

Teywl Wind

UU