Как получить информацию из штампа

[BeVi]

Доброго времени суток: Есть задача - получить данные штампов в активном документе из компаса.
Вот пример кода на Делфи для работы с 5-й версией:

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

procedure tform1.KgetStamp;  {
var s,sL:string; ident,sti,LenArr:integer;
k,i,j,cnt1,cnt2,numb:Integer;
par:IDispatch;id:IDispatch;  itemFont: ksTextItemFont;
arrpTextItem,arr:ksDynamicArray;
item:ksTextItemParam; itemLineText: ksTextLineParam;
arrpLineText: ksDynamicArray;
textItemFont: ksTextItemFont;
ref:reference;  {}
begin   {
if komp<>nil then begin
sti:=0;    ident:=0;
stamp := ksStamp( doc.GetStamp() );

if ( stamp <> nil ) and ( stamp.ksOpenStamp() <> 0 ) then
 begin
// Вытягиваю информацию
  end;

   stamp.ksCloseStamp();
 end else
   kompas.ksError ( 'Штамп не найден' );

//
stamp.ksCloseStamp;
end;    //Application.BringToFront;
}
end;

Здесь doc получается вот так:

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


Komp:=Kompasautomation(CreateOleObject('KOMPAS_graphic.Application.5'));
if komp<>nil then  kompas:=kompasobject(komp.KompasAPI);
doc:=ksdocument2d(kompas.ActiveDocument2D);


Теперь вопрос: Куда подевался тип Kompasautomation и KompasAPI тоже?
Для получения документа делаю такие действия:

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

var doc,k:OleVariant;
ko:IApplication;
kd:ksDocument2D;  t:TGUID; p:pchar;
begin
//****************************************************
k:=(GetActiveOleObject('KOMPAS.Application.7'));
doc:=(k.ActiveDocument);
doc.Close(0);
end;
Теперь для работы со штампами нудно превратить этот doc в ksDocument2D, но не получается

Как правильно действовать дальше чтоб добраться до метода GetStamp?

[Троицкий]

Вот пример кода, меняющего штамп, в Вашем случае просто заглядывать в свойство ItemParam.s.


var
  stamp     : ksStamp;
  itemParam : ksTextItemParam;

begin
// получаем ссылку на основную надпись
stamp := ksStamp( iDocument2d.GetStamp );
itemParam := ksTextItemParam( kompas.GetParamStruct(ko_TextItemParam) );
itemParam.Init;
// открываем ее для редактирования
stamp.ksOpenStamp;
// Сделать ячейку с номером 110 текущей
Stamp.ksColumnNumber(110);
// Поместить в текущую ячейку одну текстовую строку
ItemParam.s := 'Троицкий Д.И.';
Stamp.ksTextLine( ItemParam );
// Сделать ячейку с номером 130 текущей
Stamp.ksColumnNumber(130);
// Поместить в текущую ячейку одну текстовую строку - 
// сегодняшнюю дату
ItemParam.s := DateToStr(Now);
Stamp.ksTextLine( ItemParam );
// закрываем основную надпись
stamp.ksCloseStamp
end;

[BeVi]

Благодарствую, это не работает, уже пробовал.
Впрочем я нашел выход, и сейчас меня интересует другой вопрос
В IApplication есть коллекция Documents, так вот как с ней работать.
Чет постоянно на AV нарываюсь,
Мож есть пример у кого?

[Prog1]

Kompas :KompasObject;
doc       :ksDocument2D;
docPar   :ksDocumentParam;
shPar     :ksSheetPar;
stPar      :ksStandartSheet;
--------------------------------------------
docPar:= ksDocumentParam( kompas.GetParamStruct(35));
 doc:= ksDocument2D( kompas.Document2D );
 if docPar <> nil then begin docPar.Init;
     s:=timeToStr(Time);delete(s,POS(':',s),1); delete(s,POS(':',s),1);
      docPar.fileName := extractFilePath(ParamStr(0))+'Shel'+s+'.cdw';
      docPar.comment  := 'create document';
      docPar.author   := 'Comp-r';
      docPar.regime   := 0;
      docPar.type_    := lt_DocSheetStandart;
      shPar           := ksSheetPar( docPar.GetLayoutParam() );
      if ( shPar <> nil ) then begin shPar.Init;
         shPar.shtType    := 1;
         shPar.layoutName := '';
         stPar            := ksStandartSheet( shPar.GetSheetParam());
               if ( stPar <> nil ) then begin
                 stPar.format   := FormatP.f;
            stPar.multiply := FormatP.kr;
            stPar.direct:=not(FormatP.VG); //гор-вертик
                     end; end;  // создали параметры документа: лист, формат, гоиз-но, кратность
doc.ksCreateDocument(docPar);

doc.ksLineSeg(x1,y1,x2,y2,1)


Удачи!
P.S. Не уверена, что и это у Вас получится (со штампом реально работающий код)...

[YorikER]

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, KSTLB, KSConstTLB, StdCtrls, Buttons, ActiveX, ComObj;
...

procedure TForm1.BitBtn1Click(Sender: TObject);
var
  Kompas_W:   KompasObject;
  Result:     HRESULT;
  Unknown:    IInterface;
  doc:        ksDocument2D;
  stFN,s:     string;
  stamp:      ksStamp;
  itemParam:  ksTextItemParam;
  da,dai:     ksDynamicArray;
  tlp:        ksTextLineParam;
  tip:        ksTextItemParam;
  nCol,i,j,k,l: integer;
begin
  //---Проверка, загружен ли КОМПАС---
  Result := GetActiveObject(ProgIDToClassID('Kompas.Application.5'),nil,Unknown);
  if (Result = MK_E_UNAVAILABLE) then//если не доступен
  begin
    //---Загрузить Компас---
    Kompas_W := KompasObject( CreateOleObject('Kompas.Application.5') );
  end
  else begin
    //---Соединиться с уже запущенной копией сервера---
    Kompas_W := KompasObject(GetActiveOleObject('Kompas.Application.5'));
  end;
  //---Работа с КОМПАС объектом---
  if Kompas_W<>nil then
  begin
    Kompas_W.Visible:=True;// Окно Компаса видимое
    //---получить указатель на 2D документ---
    doc := ksDocument2D( Kompas_W.Document2D );
    if doc<>nil then
    begin
      //---имя файла чертежа---
      stFN:=ExtractFileDir(Application.ExeName)+'\test.cdw';
      //---открыть файл для редактирования---
      doc.ksOpenDocument(stFN,WordBool(0));
      //---получить указатель на штамп---
      stamp := ksStamp( doc.GetStamp );
      if ( stamp <> nil ) then
      begin
        //---открыть штамп---
         if ( stamp.ksOpenStamp <> 0 ) then
        begin
          //---присвоить номеру ячейки идентификатор поля штампа Наименование---
          //---номер ячейки настраивается в типах основных надписей---
          nCol:=1;
          //---встать на ячейку---
          stamp.ksColumnNumber(nCol);
          //---получить динамический массив строк из поля штампа Наименование---
          //---Наименование может быть многострочным со спецсимволами---
          da:=ksDynamicArray(stamp.ksGetStampColumnText(nCol));
          //---Преобразовать массив строк в одну строку s---
          if ((da<>nil) and (Kompas_W<>nil)) then
          begin
            i:=da.ksGetArrayCount;
            tlp:=ksTextLineParam(Kompas_W.GetParamStruct(ko_TextLineParam));
            tip:=ksTextItemParam(Kompas_W.GetParamStruct(ko_TextItemParam));
            for j := 0 to i - 1 do
            begin
              da.ksGetArrayItem(j,tlp);
              dai:=ksDynamicArray(tlp.GetTextItemArr);
              k:=dai.ksGetArrayCount;
              for l := 0 to k - 1 do
              begin
                dai.ksGetArrayItem(l,tip);
                if tip.iSNumb=0 then s:=s+' '+trim(tip.s)
                else s:=s+' @'+IntToStr(tip.iSNumb)+'~';
              end;
            end;
          end;
          //---Показать строку s на экране---
          ShowMessage(s);
          //---закрыть штамп---
          stamp.ksCloseStamp;
        end;
      end;
    end;
  end;
end;

Успехов...