interface
uses myobject,classes,cadtype;
type
taentity=class;
tatransform=class;
tabody=class;
talump=class;
tashell=class;
tasubshell=class;
taface=class;
tawire=class;
taedge=class;
tacoedge=class;
taloop=class;
tasurface=class;
{tapcurve=class;
tapcurvex=class;}
tacurve=class;
tavertex=class;
taapoint=class;
taintervall=record
 lowfinite:boolean;low:double;
 highfinite:boolean;high:double;
end;
tapar_pos=record
 u,v:double;
end;
tapar_vec=record
 du,dv:double;
end;
t1000pointer=array[0..1000]of pstring;
tamatrix=array[0..2]of tvertex;
tawriter=class
 l:tlist;
 sat:tlist;
 akts:string;
 constructor create(var asat:tlist);
 procedure write(const s:string);
 procedure writeb(b:boolean;const f,t:string);
 procedure writedouble(x:double);
 procedure writevertex(v:tvertex);
 procedure writeintervall(i:taintervall);
 procedure put(p:taentity);
end;
taentity=class(tmyobject)
public
 typ:string;
 constructor create(const atyp:string);
 procedure read(s:string);virtual;
 procedure write(w:tawriter);virtual;
end;
tabox=class(tobject)
 xb,yb,zb:taintervall;
end;
tabody=class(taentity)
 sat:tstringlist;
 lump:talump;
 wire:tawire;
 transform:tatransform;
 procedure read(s:string);override;
 procedure write(w:tawriter);override;
end;
talump=class(taentity)
 next:talump;
 shell:tashell;
 body:tabody;
 procedure read(s:string);override;
 procedure write(w:tawriter);override;
end;
tashell=class(taentity)
 next:tashell;
 SUBSHELL:tasubshell;
 FACE:taface;
 Wire:tawire;
 LUMP:talump;
 procedure read(s:string);override;
 procedure write(w:tawriter);override;
end;
tasubshell=class(taentity)
 parent:tasubshell;
 next:tasubshell;
 child:tasubshell;
 face:taface;
 wire:tawire;
 procedure read(s:string);override;
 procedure write(w:tawriter);override;
end;
taface=class(taentity)
 next:taface;
 loop:taloop;
 shell:tashell;
 subshell:tasubshell;
 surface:tasurface;
public
 reversed,double,isin:boolean;
 procedure read(s:string);override;
 procedure write(w:tawriter);override;
end;
taloop=class(taentity)
 next:taloop;
 coedge:tacoedge;
 face:taface;
 procedure read(s:string);override;
 procedure write(w:tawriter);override;
end;
tawire=class(taentity)
 next:tawire;
 coedge:tacoedge;
 owner:taentity;
 subshell:tasubshell;
public
 isin:boolean;
 procedure read(s:string);override;
 procedure write(w:tawriter);override;
end;
tacoedge=class(taentity)
 next:tacoedge;
 previous:tacoedge;
 partner:tacoedge;
 edge:taedge;
public
 reversed:boolean;
 owner:taentity;
 {pcurve:tapcurve;}
 procedure read(s:string);override;
 procedure write(w:tawriter);override;
end;
taedge=class(taentity)
 startv,endv:tavertex;
 coedge:tacoedge;
 curve:tacurve;
 procedure read(s:string);override;
 procedure write(w:tawriter);override;
end;
tavertex=class(taentity)
 edge:taedge;
 apoint:taapoint;
 procedure read(s:string);override;
 procedure write(w:tawriter);override;
end;
taapoint=class(taentity)
public
 position:tvertex;
 procedure read(s:string);override;
 procedure write(w:tawriter);override;
end;
tacurve=class(taentity)
end;
taellipse=class(tacurve)
public
 center,normal,major:tvertex;
public
 ratio:double;
 data:taintervall;
 procedure read(s:string);override;
 procedure write(w:tawriter);override;
end;
tastraight=class(tacurve)
public
 root,dir:tvertex;
 curve:taintervall;
 procedure read(s:string);override;
 procedure write(w:tawriter);override;
end;
{
tapcurve=class
 def_type:integer;
 // Definition of an explicit pcurve.
 def:tapcurvex;// ignored (null) if def_type is non-zero.
 // Definition of an implicit pcurve.
 cur:tacurve;   // ignored (NULL) if def_type is zero.
 off:tapar_vec;  // ignored (zero) if def_type is zero.
end;

tapcurvex=class(tobject)
 fit:tapar_cur;  // spline which fits curve in a parametric
      // surface
 rev:integer;  // true if this curve opposes the direction
      // of the underlying spline.
 off:tapar_vec;  //
end;
}
tasurface=class(taentity)
end;
taplane=class(tasurface)
public
 root,normal,u:tvertex;
 reversedv:boolean;
 urange,vrange:taintervall;
 procedure read(s:string);override;
 procedure write(w:tawriter);override;
end;
tacone=class(tasurface)
 {ellipse}
public
 center,normal,major:tvertex;
 ratio:double;
 curve:taintervall;
 sine,cosine:double;
 scale:double;
 reversedu:boolean;
 urange,vrange:taintervall;
 procedure read(s:string);override;
 procedure write(w:tawriter);override;
end;
tasphere=class(tasurface)
public
 center:tvertex;
 radius:double;
 uvorigin,pole:tvertex;
 reversedv:boolean;
 procedure read(s:string);override;
 procedure write(w:tawriter);override;
end;
tatransform=class(taentity)
public
 affine:tamatrix;
 transl:tvertex;
 scale:double;
 rotation,reflection,shear:boolean;
 procedure read(s:string);override;
 procedure write(w:tawriter);override;
end;
procedure readsat(name:string;doeval:boolean;var body:tabody);

implementation
uses sysutils;
var l:tlist;
var typ:string;
{
-8 cone-surface $-1 0 0 0 0 0 1 20 0 0 1 I I -0.37139067635410372 0.9284766908852593 20 forward I I I I #
}
function gettyp(var s:string):string;
var i:integer;
begin
if s[1]='-'then begin
 i:=pos(' ',s);delete(s,1,i);
end;
i:=pos(' ',s);
result:=copy(s,1,i-1);delete(s,1,i);
end;
function getp(var s:string):pointer;
var i,n:integer;
begin
if s[1]='$'then begin
 i:=pos(' ',s);
 n:=strtoint(copy(s,2,i-2));
 if n<0 then result:=nil else result:=l[n];
 delete(s,1,i);
end else result:=nil;
end;
function getb(ch:char;var s:string):boolean;
var i,n:integer;
begin
result:=s[1]=ch;
i:=pos(' ',s);
delete(s,1,i);
end;
function getvertex(var s:string):tvertex;
var i,j:integer;
begin
for j:=0 to 2 do begin
 i:=pos(' ',s);
 result[j]:=strtofloat(copy(s,1,i-1));
 delete(s,1,i);
end;
end;
function getdouble(var s:string):double;
var i:integer;
begin
i:=pos(' ',s);
result:=strtofloat(copy(s,1,i-1));
delete(s,1,i);
end;
function getintervall(var s:string):taintervall;
var i:integer;
begin
with result do begin
 lowfinite:=not(s[1]='I');
 i:=pos(' ',s);delete(s,1,i);
 if lowfinite then low:=getdouble(s);
 highfinite:=not(s[1]='I');
 i:=pos(' ',s);delete(s,1,i);
 if highfinite then high:=getdouble(s);
end;
end;
constructor tawriter.create(var asat:tlist);
begin
l:=tlist.create;sat:=tlist.create;asat:=sat;
end;
procedure tawriter.write(const s:string);
begin
akts:=akts+s+' ';
end;
procedure tawriter.writeb(b:boolean;const f,t:string);
begin
if b then write(t)else write(f);
end;
procedure tawriter.writedouble(x:double);
begin
write(floattostr(x));
end;
procedure tawriter.writevertex(v:tvertex);
var i:integer;
begin
for i:=0 to 2 do write(floattostr(v[i]));
end;
procedure tawriter.writeintervall(i:taintervall);
begin
if i.lowfinite then begin
 write('F');write(floattostr(i.low));
end else write('I');
if i.highfinite then begin
 write('F');write(floattostr(i.high));
end else write('I');
end;
procedure tawriter.put(p:taentity);
var olds:string;
 i,n:integer;
begin
olds:=akts;
if p=nil then write('$-1')else begin
 i:=l.indexof(p);
 if i>=0 then write('$'+inttostr(i))
 else begin
  l.add(p);n:=l.count-1;akts:='';
  write(inttostr(-n)+' '+p.typ+' ');
  p.write(self);
  if n>=sat.count then sat.count:=n+1;
  sat.items[n]:=newstr(akts);
  akts:=olds;
  write('$'+inttostr(n));
 end;
end;
end;

constructor taentity.create(const atyp:string);
begin
typ:=atyp;
end;
procedure taentity.read(s:string);
begin
end;
procedure taentity.write(w:tawriter);
begin
w.write('$-1');
end;
procedure tabody.read(s:string);
begin
typ:=gettyp(s);
getp(s);
lump:=getp(s);
wire:=getp(s);
transform:=getp(s);
end;
procedure tabody.write(w:tawriter);
begin
inherited write(w);
w.put(lump);
w.put(wire);
w.put(transform);
end;
procedure talump.read(s:string);
begin
typ:=gettyp(s);
getp(s);
next:=getp(s);
shell:=getp(s);
body:=getp(s);
end;
procedure talump.write(w:tawriter);
begin
inherited write(w);
w.put(next);
w.put(shell);
w.put(body);
end;
procedure tashell.read(s:string);
begin
typ:=gettyp(s);
getp(s);
next:=getp(s);
subshell:=getp(s);
face:=getp(s);
wire:=getp(s);
lump:=getp(s);
end;
procedure tashell.write(w:tawriter);
begin
inherited write(w);
w.put(next);
w.put(subshell);
w.put(face);
w.put(wire);
w.put(lump);
end;
procedure tasubshell.read(s:string);
begin
typ:=gettyp(s);
getp(s);
parent:=getp(s);
next:=getp(s);
child:=getp(s);
face:=getp(s);
wire:=getp(s);
end;
procedure tasubshell.write(w:tawriter);
begin
inherited write(w);
w.put(parent);
w.put(next);
w.put(child);
w.put(face);
w.put(wire);
end;
procedure taface.read(s:string);
begin
typ:=gettyp(s);
getp(s);
next:=getp(s);
loop:=getp(s);
shell:=getp(s);
subshell:=getp(s);
surface:=getp(s);
reversed:=getb('r',s);
double:=getb('d',s);
if double then isin:=getb('i',s);
end;
procedure taface.write(w:tawriter);
begin
inherited write(w);
w.put(next);
w.put(loop);
w.put(shell);
w.put(subshell);
w.put(surface);
w.writeb(reversed,'forward','reversed');
w.writeb(double,'single','double');
if double then w.writeb(isin,'out','in');
end;
procedure taloop.read(s:string);
begin
typ:=gettyp(s);
getp(s);
next:=getp(s);
coedge:=getp(s);
face:=getp(s);
end;
procedure taloop.write(w:tawriter);
begin
inherited write(w);
w.put(next);
w.put(coedge);
w.put(face);
end;
procedure tawire.read(s:string);
begin
typ:=gettyp(s);
getp(s);
next:=getp(s);
coedge:=getp(s);
owner:=getp(s);
subshell:=getp(s);
isin:=getb('i',s);
end;
procedure tawire.write(w:tawriter);
begin
inherited write(w);
w.put(next);
w.put(coedge);
w.put(owner);
w.put(subshell);
w.writeb(isin,'out','in');
end;
procedure tacoedge.read(s:string);
begin
typ:=gettyp(s);
getp(s);
next:=getp(s);
previous:=getp(s);
partner:=getp(s);
edge:=getp(s);
reversed:=getb('r',s);
owner:=getp(s);
end;
procedure tacoedge.write(w:tawriter);
begin
inherited write(w);
w.put(next);
w.put(previous);
w.put(partner);
w.put(edge);
w.writeb(reversed,'forward','reversed');
w.put(owner);
end;
procedure taedge.read(s:string);
begin
typ:=gettyp(s);
getp(s);
startv:=getp(s);
endv:=getp(s);
coedge:=getp(s);
curve:=getp(s);
end;
procedure taedge.write(w:tawriter);
begin
inherited write(w);
w.put(startv);
w.put(endv);
w.put(coedge);
w.put(curve);
end;
procedure tavertex.read(s:string);
begin
typ:=gettyp(s);
getp(s);
edge:=getp(s);
apoint:=getp(s);
end;
procedure tavertex.write(w:tawriter);
begin
inherited write(w);
w.put(edge);
w.put(apoint);
end;
procedure taapoint.read(s:string);
begin
typ:=gettyp(s);
getp(s);
position:=getvertex(s);
end;
procedure taapoint.write(w:tawriter);
begin
inherited write(w);
w.writevertex(position);
end;
procedure taellipse.read(s:string);
begin
typ:=gettyp(s);
getp(s);
center:=getvertex(s);
normal:=getvertex(s);
major:=getvertex(s);
ratio:=getdouble(s);
data:=getintervall(s);
end;
procedure taellipse.write(w:tawriter);
begin
inherited write(w);
w.writevertex(center);
w.writevertex(normal);
w.writevertex(major);
w.writedouble(ratio);
w.writeintervall(data);
end;
procedure tastraight.read(s:string);
begin
typ:=gettyp(s);
getp(s);
root:=getvertex(s);
dir:=getvertex(s);
curve:=getintervall(s);
end;
procedure tastraight.write(w:tawriter);
begin
inherited write(w);
w.writevertex(root);
w.writevertex(dir);
w.writeintervall(curve);
end;
procedure taplane.read(s:string);
begin
typ:=gettyp(s);
getp(s);
root:=getvertex(s);
normal:=getvertex(s);
u:=getvertex(s);
reversedv:=getb('r',s);
urange:=getintervall(s);
vrange:=getintervall(s);
end;
procedure taplane.write(w:tawriter);
begin
inherited write(w);
w.writevertex(root);
w.writevertex(normal);
w.writevertex(u);
w.writeb(reversedv,'forward_v','reversed_v');
w.writeintervall(urange);
w.writeintervall(vrange);
end;
procedure tacone.read(s:string);
begin
typ:=gettyp(s);
getp(s);
center:=getvertex(s);
normal:=getvertex(s);
major:=getvertex(s);
ratio:=getdouble(s);
curve:=getintervall(s);
sine:=getdouble(s);
cosine:=getdouble(s);
scale:=getdouble(s);
reversedu:=getb('r',s);
urange:=getintervall(s);
vrange:=getintervall(s);
end;
procedure tacone.write(w:tawriter);
begin
inherited write(w);
w.writevertex(center);
w.writevertex(normal);
w.writevertex(major);
w.writedouble(ratio);
w.writeintervall(curve);
w.writedouble(sine);
w.writedouble(cosine);
w.writedouble(scale);
w.writeb(reversedu,'forward','reversed');
w.writeintervall(urange);
w.writeintervall(vrange);
end;
procedure tasphere.read(s:string);
begin
typ:=gettyp(s);
getp(s);
center:=getvertex(s);
radius:=getdouble(s);
uvorigin:=getvertex(s);
pole:=getvertex(s);
reversedv:=getb('r',s);
end;
procedure tasphere.write(w:tawriter);
begin
inherited write(w);
w.writevertex(center);
w.writedouble(radius);
w.writevertex(uvorigin);
w.writevertex(pole);
w.writeb(reversedv,'forward_v','reversed_v');
end;
procedure tatransform.read(s:string);
var i:integer;
begin
typ:=gettyp(s);
getp(s);
for i:=0 to 2 do affine[i]:=getvertex(s);
transl:=getvertex(s);
scale:=getdouble(s);
rotation:=getb('r',s);
reflection:=getb('r',s);
shear:=getb('s',s);
end;
procedure tatransform.write(w:tawriter);
var i:integer;
begin
inherited write(w);
for i:=0 to 2 do w.writevertex(affine[i]);
w.writevertex(transl);
w.writedouble(scale);
w.writeb(rotation,'no_rotate','rotate');
w.writeb(reflection,'no_reflect','reflect');
w.writeb(shear,'no_shear','shear');
end;

procedure readsat(name:string;doeval:boolean;var body:tabody);
var f:text;
 i,n:integer;
 s:string;
 it:taentity;
 sat:tstringlist;
begin
assign(f,name);reset(f);
sat:=tstringlist.create;
for i:=1 to 3 do readln(f,s);
n:=0;
readln(f,s);
while (s<>'')and(s[1]<>'E')do begin
 sat.add(s);
 readln(f,s);
 inc(n);
end;
close(f);
if doeval then begin
 l:=tlist.create;
 for i:=0 to n-1 do begin
  s:=sat[i];
  typ:=gettyp(s);
  if typ='body'then it:=tabody.create(typ)
  else if typ='lump'then it:=talump.create(typ)
  else if typ='transform'then it:=tatransform.create(typ)
  else if typ='shell'then it:=tashell.create(typ)
  else if typ='face'then it:=taface.create(typ)
  else if typ='loop'then it:=taloop.create(typ)
  else if typ='cone-surface'then it:=tacone.create(typ)
  else if typ='plane-surface'then it:=taplane.create(typ)
  else if typ='sphere-surface'then it:=taplane.create(typ)
  else if typ='coedge'then it:=tacoedge.create(typ)
  else if typ='edge'then it:=taedge.create(typ)
  else if typ='vertex'then it:=tavertex.create(typ)
  else if typ='ellipse-curve'then it:=taellipse.create(typ)
  else if typ='straight-curve'then it:=tastraight.create(typ)
  else if typ='point'then it:=taapoint.create(typ)
  else it:=nil;
  l.add(it);
 end;
 for i:=0 to n-1 do begin
  s:=sat[i];
  if l[i]<>nil then taentity(l[i]).read(s);
 end;
 body:=l[0];
end else begin
 body:=tabody.create('body');
 body.lump:=nil;
end;
body.sat:=sat;
end;

procedure writesat(name:string;doeval:boolean;body:tabody);
var f:text;
 i:integer;
 w:tawriter;
 satl:tlist;
 s:string;
begin
assign(f,name);rewrite(f);
writeln(f,'400 0 1 0');
writeln(f,'7 Unknown 13 ACIS 4.0.1 NT 24 Mon Nov 30 11:41:21 1998');
writeln(f,'-1 9.9999999999999995e-007 1e-010');
if doeval then begin
 body.sat:=tstringlist.create;
 w:=tawriter.create(satl);
 w.put(body);
 body.sat:=tstringlist.create;
 for i:=0 to satl.count-1 do begin
  s:=pstring(satl[i])^;
  body.sat.add(s);
 end;
end;
for i:=0 to body.sat.count-1 do writeln(f,body.sat[i]+'#');
writeln(f,'End-of-ACIS-data');
close(f);
end;
var b:tabody;
begin
{test}
readsat('c:\acis\test\c1.sat',true,b);
writesat('c:\acis\test\c1x.sat',true,b);
end.

Beispiel von ACIS SAT Dateien:

Eine Kugel : Mittlepunkt 0,0,0 Radius 35 uv Origin 1, 0, 0 Pole 0,0,1
(siehe sphere-surface)
Die Kugel hat eine Fläche aber keine Kante und keinen Punkt.
Die Fläche hat keine Begrenzung

400 0 1 0
7 Unknown 13 ACIS 4.0.1 NT 24 Mon Nov 30 11:41:21 1998
-1 9.9999999999999995e-007 1e-010
-0 body $-1 $1 $-1 $2 #
-1 lump $-1 $-1 $3 $0 #
-2 transform $-1 1 0 0 0 1 0 0 0 1 0 0 0 1 no_rotate no_reflect no_shear #
-3 shell $-1 $-1 $-1 $4 $-1 $1 #
-4 face $-1 $-1 $-1 $3 $-1 $5 forward single #
-5 sphere-surface $-1 0 0 0 35 1 0 0 0 0 1 forward_v I I I I #
End-of-ACIS-data

Ein Zylinder Achse von 0,0,-25 nach 0,0,25
Radius 10
3 Flächen:
Mantel: Face:-4 Geometrie: -8: cone-srface loop: -7
Stirnseite oben: Face --10 Geometrie: -17 plane-surface
unten: Face:-6 Geometrie: -12 plane-surface
2 Kanten:
edge:-20: Geometrie: -25 ellipse-curve
edge:-22 Geometrie:  -28 ellipse curve
400 0 1 0
7 Unknown 13 ACIS 4.0.1 NT 24 Mon Nov 30 11:41:21 1998
-1 9.9999999999999995e-007 1e-010
-0 body $-1 $1 $-1 $2 #
-1 lump $-1 $-1 $3 $0 #
-2 transform $-1 1 0 0 0 1 0 0 0 1 0 0 25 1 rotate no_reflect no_shear #
-3 shell $-1 $-1 $-1 $4 $-1 $1 #
-4 face $5 $6 $7 $3 $-1 $8 forward single #
-5 fmesh-eye-attrib $-1 $-1 $-1 $4 #
-6 face $9 $10 $11 $3 $-1 $12 forward single #
-7 loop $-1 $13 $14 $4 #
-8 cone-surface $-1 0 0 0 0 0 1 20 0 0 1 I I -0.37139067635410372 0.9284766908852593 20 forward I I I I #
-9 fmesh-eye-attrib $-1 $-1 $-1 $6 #
-10 face $15 $-1 $16 $3 $-1 $17 forward single #
-11 loop $-1 $-1 $18 $6 #
-12 plane-surface $-1 0 0 -25 0 0 -1 -1 0 0 forward_v I I I I #
-13 loop $-1 $-1 $19 $4 #
-14 coedge $-1 $14 $14 $18 $20 reversed $7 $-1 #
-15 fmesh-eye-attrib $-1 $-1 $-1 $10 #
-16 loop $-1 $-1 $21 $10 #
-17 plane-surface $-1 0 0 25 0 0 1 1 0 0 forward_v I I I I #
-18 coedge $-1 $18 $18 $14 $20 forward $11 $-1 #
-19 coedge $-1 $19 $19 $21 $22 reversed $13 $-1 #
-20 edge $23 $24 $24 $18 $25 forward #
-21 coedge $-1 $21 $21 $19 $22 forward $16 $-1 #
-22 edge $26 $27 $27 $21 $28 forward #
-23 ptlist-eye-attrib $-1 $-1 $-1 $20 #
-24 vertex $-1 $20 $29 #
-25 ellipse-curve $-1 0 0 -25 0 0 -1 30 0 0 1 I I #
-26 ptlist-eye-attrib $-1 $-1 $-1 $22 #
-27 vertex $-1 $22 $30 #
-28 ellipse-curve $-1 0 0 25 0 0 1 10 0 0 1 I I #
-29 point $-1 30 0 -25 #
-30 point $-1 10 0 25 #
End-of-ACIS-data