Пример выполнения. Кнопка «Очистить таблицу»:

Форма в Delphi:

Кнопка «Очистить таблицу»:

var i,w_i: byte;

begin

w_i:= SG.RowCount;

SG.RowCount:= 33;

for i:= 1 to 32 do SG.Rows[i].Clear;

SG.RowCount:= w_i;

end;

Кнопка «Сохранить»:

var

f: TextFile;

i,j: byte;

begin

if SD.Execute and((not FileExists(SD.FileName))or

(Application.MessageBox('Заменить существующий файл?','Внимание',

MB_YESNO or MB_ICONQUESTION) = IDYES)) then

begin

AssignFile(f,SD.FileName);

ReWrite(f);

WriteLn(f,nDoc.Text);

WriteLn(f,nName1.Text);

WriteLn(f,nName2.Text);

WriteLn(f,nName3.Text);

WriteLn(f,nPredpr.Text);

WriteLn(f,nRazr.Text);

WriteLn(f,nProv.Text);

WriteLn(f,nUtv.Text);

WriteLn(f,nCol.Text);

WriteLn(f,nList.Text);

for i:= 1 to SG.RowCount-1 do

for j:= 0 to 6 do WriteLn(f,SG.Cells[j,i]);

CloseFile(f);

end;

end;

Кнопка «Открыть»:

var

f: TextFile;

i,j: byte;

s: string;

begin

if OD.Execute and FileExists(OD.FileName) then

begin

AssignFile(f,OD.FileName);

Reset(f);

ReadLn(f,s);

nDoc.Text:= s;

ReadLn(f,s);

nName1.Text:= s;

ReadLn(f,s);

nName2.Text:= s;

ReadLn(f,s);

nName3.Text:= s;

ReadLn(f,s);

nPredpr.Text:= s;

ReadLn(f,s);

nRazr.Text:= s;

ReadLn(f,s);

nProv.Text:= s;

ReadLn(f,s);

nUtv.Text:= s;

ReadLn(f,s);

nCol.Text:= s;

ReadLn(f,s);

nList.Text:= s;

if StrToInt(s) = 1 then SG.RowCount:= 30 else SG.RowCount:= 33;

for i:= 1 to SG.RowCount-1 do

for j:= 0 to 6 do

begin

ReadLn(f,s);

SG.Cells[j,i]:= s;

end;

CloseFile(f);

SetWidth;

end;

end;

Кнопка «Отправить в AUTOCAD»:

function StrPreob(s: string): string;

var

i: integer;

rez: string;

begin

rez:= '';

for i:= 1 to Length(s) do

begin

rez:= rez+s[i];

if s[i] = '\' then rez:= rez+'\';

end;

StrPreob:= rez;

end;

var

fScr: TextFile;

nF: char;

i,j,k,con,col_razd: integer;

s: string;

fl: boolean;

begin

if ACADPath <> '' then

begin

if nList.Value > 1 then

begin

nF:= '2';

con:= 32;

end

else

begin

nF:= '1';

con:= 29;

end;

AssignFile(fScr,FPath+'PrScript.scr');

ReWrite(fScr);

WriteLn(fScr,'(command "_MENU" "'+StrPreob(FPath)+'MyMenu.mns")');

WriteLn(fScr,'(command "_INSERT" "'+StrPreob(FPath)

+'BlA4_'+nF+'" "0,0" 1 1 0)');

WriteLn(fScr,'(setq f_Rezult "'+StrPreob(FPath)+'Rezult.tmp")');

WriteLn(fScr,'(load "'+StrPreob(FPath)+'SpLisp.lsp" "Файл не найден")');

CloseFile(fScr);

AssignFile(fScr,FPath+'Rezult.tmp');

ReWrite(fScr);

WriteLn(fScr,nList.Value);

WriteLn(fScr,nDoc.Text);

if nList.Value = 1 then

begin

k:= 0;

if nName1.Text <> '' then inc(k);

if nName2.Text <> '' then inc(k);

if nName3.Text <> '' then inc(k);

WriteLn(fScr,k);

if nName1.Text <> '' then WriteLn(fScr,nName1.Text);

if nName2.Text <> '' then WriteLn(fScr,nName2.Text);

if nName3.Text <> '' then WriteLn(fScr,nName3.Text);

WriteLn(fScr,nPredpr.Text);

WriteLn(fScr,nRazr.Text);

WriteLn(fScr,nProv.Text);

WriteLn(fScr,nUtv.Text);

WriteLn(fScr,nCol.Value);

end;

col_razd:= OFil.GetCount-1;

for i:= 1 to con do

for j:= 0 to 6 do

begin

s:= SG.Cells[j,i];

if (j = 4) then

if SG.Cells[4,i] <> '' then

begin

fl:= false;

for k:= 0 to col_razd do

if SG.Cells[4,i] = OFil.GetStr(k) then fl:= true;

if fl then

begin

WriteLn(fScr,'_m');

s:= '%%u'+s;

end

else WriteLn(fScr,'');

end

else WriteLn(fScr,'');

WriteLn(fScr,s);

end;

CloseFile(fScr);

ShellExecute(Application.Handle,nil,PChar(ACADPath),

PChar('/b "'+FPath+'PrScript.scr"'),nil,SW_SHOWNORMAL);

end

else

Application.MessageBox('На данном компьютере не обнаружено приложение, '

+'связанное с файлами *.dwg (AUTOCAD).',

'Внимание',MB_OK OR MB_ICONWARNING);

end;

Программа на Lisp’e:

;--------------------------------------------------------------

;----------------"Правильный" вывод строки в ячейку------------

;--------------------------------------------------------------

(defun DrawStr (mStyle mHeight mJustify mPoint1 mPoint2 mStr

/ R H L1 L2 X1 Y1)

(if (/= mStr "")

(progn

(command "_-style" mStyle "" "" "" "" "" "" "")

(setq

R (textbox (list (cons 1 mStr)))

L1 (abs (- (caar R) (caadr R)))

L2 (- (car mPoint2) (car mPoint1) 2)

)

(if (= mJustify "_m")

(setq H (abs (- (cadar R) (cadadr R))))

(setq H mHeight)

)

(setq Y1 (+ (- H mHeight) (/ (- (+ (cadr mPoint2)

(cadr mPoint1)) H) 2)))

(if (> L2 L1)

(progn

(if (= mJustify "_c")

(progn

(setq X1 (/ (+ (car mPoint2) (car mPoint1)) 2))

(command "_text" "_j" "_c" (list X1 Y1) "0" mStr)

)

)

(if (= mJustify "_m")

(progn

(setq

X1 (/ (+ (car mPoint2) (car mPoint1)) 2)

Y1 (/ (+ (cadr mPoint2) (cadr mPoint1)) 2)

)

(command "_text" "_j" "_m" (list X1 Y1) "0" mStr)

)

)

(if (= mJustify "")

(command "_text" (list (+ (car mPoint1) 1) Y1)

"0" mStr)

)

)

(command "_text" "_j" "_f"

(list (+ (car mPoint1) 0.5) Y1)

(list (- (car mPoint2) 1.5) Y1) mStr)

)

)

)

)

;-------------------------------------------------------------

;-------------------Отключаем привязку и т.д.-----------------

;-------------------------------------------------------------

(setvar "cmdecho" 0)

(command

"_zoom" "_a"

"_-osnap" "_none"

"_snap" "_off"

"_ortho" "_off"

"_grid" "_off"

)

;-------------------------------------------------------------

;--------Считываем данные штампа и выводим их на экран--------

;-------------------------------------------------------------

(setq

fil (open f_Rezult "r")

s_n_List (read-line fil)

n_List (atoi s_n_List)

)

(if (= n_List 1)

(progn

(DrawStr "s35" 3.5 "_c" '(170.0 25.0) '(185.0 20.0)

s_n_List)

(DrawStr "s50" 5.0 "_c" '(85.0 45.0) '(205.0 30.0)

(read-line fil))

(setq col_StrName (atoi (read-line fil)))

(if (= col_StrName 1)

(DrawStr "s50" 5.0 "_c" '(85.0 20.0) '(155.0 15.0)

(read-line fil))

)

(if (= col_StrName 2)

(progn

(DrawStr "s50" 5.0 "_c" '(85.0 24.0) '(155.0 19.0)

(read-line fil))

(DrawStr "s50" 5.0 "_c" '(85.0 16.0) '(155.0 11.0)

(read-line fil))

)

)

(if (= col_StrName 3)

(progn

(DrawStr "s50" 5.0 "_c" '(85.0 28.0) '(155.0 23.0)

(read-line fil))

(DrawStr "s50" 5.0 "_c" '(85.0 20.0) '(155.0 15.0)

(read-line fil))

(DrawStr "s50" 5.0 "_c" '(85.0 12.0) '(155.0 8.0)

(read-line fil))

)

)

(DrawStr "s50" 5.0 "_c" '(155.0 20.0) '(205.0 5.0)

(read-line fil))

(DrawStr "s35" 3.5 "" '(37.0 30.0) '(60.0 25.0)

(read-line fil))

(DrawStr "s35" 3.5 "" '(37.0 25.0) '(60.0 20.0)

(read-line fil))

(DrawStr "s35" 3.5 "" '(37.0 10.0) '(60.0 5.0)

(read-line fil))

(DrawStr "s35" 3.5 "_c" '(185.0 25.0) '(205.0 20.0)

(read-line fil))

)

(progn

(DrawStr "s35" 3.5 "_c" '(195.0 13.0) '(205.0 5.0) s_n_List)

(DrawStr "s50" 5.0 "_c" '(85.0 20.0) '(195.0 5.0)

(read-line fil))

)

)

;--------------------------------------------------------------

;-----Считываем данные спецификации и выводим их на экран------

;--------------------------------------------------------------

(if (= n_list 1)

(setq Col_Str 29)

(setq Col_Str 32)

)

(setq w_Str 277.0)

(repeat Col_Str

(DrawStr "s50" 5.0 "_c" (list 20.0 w_Str)

(list 26.0 (- w_Str 8)) (read-line fil))

(DrawStr "s50" 5.0 "_c" (list 26.0 w_Str)

(list 32.0 (- w_Str 8)) (read-line fil))

(DrawStr "s50" 5.0 "_c" (list 32.0 w_Str)

(list 40.0 (- w_Str 8)) (read-line fil))

(DrawStr "s50" 5.0 "" (list 40.0 w_Str)

(list 110.0 (- w_Str 8)) (read-line fil))

(DrawStr "s50" 5.0 (read-line fil)

(list 110.0 w_Str) (list 170.0 (- w_Str 8)) (read-line fil))

(DrawStr "s50" 5.0 "_c"

(list 170.0 w_Str) (list 180.0 (- w_Str 8)) (read-line fil))

(DrawStr "s50" 5.0 "" (list 180.0 w_Str)

(list 205.0 (- w_Str 8)) (read-line fil))

(setq w_Str (- w_Str 8))

)

(close fil)