Mix-AnsichtPCX mit Rand (Software)
verfasst von Martin Vogel
, Dortmund, 19.09.2007, 17:03 Uhr
Hallo Andreas,
das mit dem Balken ist Programmierfaulheit. PCX-Dateien können ja scheinbar beliebige Breiten haben, kodiert werden aber immer nur Vielfache von acht Pixeln. Weil PCX2DXF nicht abfragt, welche Breite gewollt ist, sondern die kompletten Zeilen dekodiert, entsteht bei manchen Bildern ein Rand. Ich fand es einfacher, den im CAD-Programm zu löschen, als die Fallunterscheidung zu programmieren 
» Und: Gibt es die Option, den Schraffurwinkel zu ändern (ich weiss: use it,
» as it is...)?
Das wäre ein hübscher Effekt, erfordert aber auch ein paar Zeilen Programmcode. Wer Spaß daran hat, kann ja mal das folgende Programm anpassen:
{$A+,B-,D+,E-,F-,G-,I-,L-,N-,O-,R-,S-,V-,X-}
{$M 8192,0,0}
uses dos,crt,viewprim,windows,disk,disundas;
{PCX -> DXF
Scannt eine monochrome PCX-Datei zeilenweise und erzeugt
eine DXF-Datei, die die gesetzten Bildpunkte als horizontale
Linien enthaelt.
19.09.07 1.3 Nur neue Adresse...
13.06.94 1.1 LIMITEN werden im Header gesetzt.
10.06.94 1.0 Tja, laeuft.}
const Version='1.2';
type headertyp=Record
id:byte; {10=PCX}
version:byte; {0=2.5, 2=2.8 m.Pal, 3=2.8 o.Pal, 5=3.0}
rle:byte; {1=RLE-Kompression}
bipp:Byte; {Bits pro Pixel}
xmin,
ymin,
xmax,
ymax:Word; {Fensterkoordinaten}
xdpi,
ydpi:Word; {Aufloesung}
pal:array[0..15,1..3] of Byte;
reserviert:Byte;
Farbebenen:Byte; {1 oder 4}
BpZ:Word; {Gerade Anzahl Bytes pro Bildzeile}
PalTyp:Word; {1=Mono/Col, 2=Grau}
Muell:Array[1..58] of Byte;
end;
var header:headertyp;
var einname,ausname:pathstr;
var i:integer;
var pcx:file;
var dxf:text;
var dxfpuffer:array[1..32768] of Byte;
var pfad:pathstr;
var name:namestr;
var ext:extstr;
(*---------------------------------------------------------------------
HEADER LESEN
---------------------------------------------------------------------*)
Procedure Liesheader;
var i:integer;
BEGIN
blockread(pcx,header,128);
with Header do
begin
if id<>$A Then Write('Keine PCX-Datei!')
else
begin
Writeln('Kenndaten der Quelldatei:');
Writeln('-------------------------');
Write('ZSoft Paintbrush File Format, Version ');
Case Version of
0:Writeln('2.5');
2:Writeln('2.8 mit Palette');
3:Writeln('2.8 ohne Palette');
5:Writeln('3.0');
else writeln('unbekannt!');
end;
if rle=1
then writeln('Kompression durch RLE-Kodierung, Kompressionsfaktor: ',
0.125*bipp*Farbebenen*(1.0+xmax-xmin)*(1.0+ymax-ymin)/(filesize(pcx)-128):0:3)
else writeln('Datei ist nicht komprimiert!');
WriteLN(Farbebenen,' Farbebene(n) pro Bildpunkt, '
,bipp,' Bit pro Farbebene');
writeln('Breite = ',1+xmax-xmin,' Punkte, ',
'H”he = ',1+ymax-ymin,' Zeilen');
writeln('Dateigroesse: ',filesize(pcx),' Byte');
end;
end;
end; {Liesheader}
(*---------------------------------------------------------------------
Ein Byte gepuffert lesen
---------------------------------------------------------------------*)
const maxpuffer=$3FFF;
var puffer:Array[0..maxpuffer] of Byte;
var pufpos:word;
function liesbyte:Byte;
var gelesen:Integer;
begin
if pufpos>maxpuffer
then
begin
blockread(pcx,puffer,sizeof(puffer),gelesen);
pufpos:=0;
end;
liesbyte:=puffer[pufpos];
inc(pufpos);
end;
(*---------------------------------------------------------------------
Eine Zeile lesen
---------------------------------------------------------------------*)
PROCEDURE LiesZeile(VAR Z:ByteFeldTyp;Sollaenge:Word);
VAR L,i:Word;
b:byte;
b2:byte;
BEGIN
L:=0;
Repeat
b:=liesbyte;
if b<193 then
BEGIN
Z[L]:=b;
inc(L);
END
else
BEGIN
b:=b and 63;
b2:=liesbyte;
fillchar(Z[l],b,char(b2));
inc(l,b);
END;
until L>=Sollaenge;
END;
(*---------------------------------------------------------------------
KONVERTIERUNG
---------------------------------------------------------------------*)
var e:BytefeldTyp;
var linienzahl:longint;
const nl=#13#10;
const Layer='PCX';
Procedure KonvertiereZeile(y:integer);
var c:Word;
var i,j,x:integer;
var stift:boolean;
var b:byte;
const oben=true;
const unten=not oben;
procedure behandlepunkt(gesetzt:boolean);
begin
if gesetzt
then
begin
if stift=oben
then
begin
Write(DXF,'0',nl,'LINE',nl,'8',nl,Layer,nl,
'10',nl,x,nl,'20',nl,y,nl);
stift:=unten;
inc(linienzahl);
end
end
else
if stift=unten
then
begin
Write(DXF,'11',nl,x,nl,'21',nl,y,nl);
stift:=oben;
end;
inc(x);
end;
BEGIN
{Zeile von links nach rechts durchgehen und gesetzte Punkte
durch Linien verbinden}
x:=0;
stift:=oben;
for i:=0 to header.bpz-1 do
BEGIN
b:=e[i];
behandlepunkt(b and 128 = 0);
behandlepunkt(b and 64 = 0);
behandlepunkt(b and 32 = 0);
behandlepunkt(b and 16 = 0);
behandlepunkt(b and 8 = 0);
behandlepunkt(b and 4 = 0);
behandlepunkt(b and 2 = 0);
behandlepunkt(b and 1 = 0);
END; {for i...}
if stift=unten
then Write(DXF,'11',nl,x,nl,'21',nl,y,nl);
END; {Konvertiere Zeile}
PROCEDURE Konvertiere;
var Zeile:integer;
begin
Writeln;
fsplit(fexpand(einname),pfad,name,ext);
Write('Name der zu erzeugenden Datei [',name,'.DXF]: ');
ausname:=paramstr(2);
if ausname='' then readln(ausname) else writeln(ausname);
if ausname='' then
begin
ausname:=pfad+name+'.DXF';
writeln(ausname);
end;
fsplit(fexpand(ausname),pfad,name,ext);
if ext='' then ext:='.DXF';
ausname:=pfad+name+ext;
If fileexist(ausname) then
begin
Writeln;
if fexpand(einname)=fexpand(ausname) then
begin
writeln('FEHLER: Quelldatei darf nicht Konvertierungsziel sein.');
halt(3);
end;
if not Janein('Datei existiert. Ueberschreiben')
Then halt(2);
end;
Writeln;
assign(DXF,ausname);
settextbuf(dxf,dxfpuffer);
rewrite(dxf);
if ioresult<>0 then
begin
writeln('FEHLER: Kann Zieldatei nicht anlegen.');
halt(1);
end;
write(DXF,'0',nl,'SECTION',nl,'2',nl,'HEADER',nl);
write(DXF,'9',nl,'$LIMMIN',nl,'10',nl,'0',nl,'20',nl,'0',nl);
with header do
write(DXF,'9',nl,'$LIMMAX',nl,'10',nl,xmax-xmin,nl,'20',nl,ymax-ymin,nl);
write(DXF,'0',nl,'ENDSEC',nl);
write(DXF,'0',nl,'SECTION',nl,'2',nl,'ENTITIES',nl);
linienzahl:=0;
for Zeile:=0 to header.ymax-header.ymin do
begin
Write(Zeile,' Zeilen gelesen, ',linienzahl,' Vektoren geschrieben.',#13);
LiesZeile(e,header.bpz);
KonvertiereZeile(header.ymax-header.ymin-Zeile);
end;
write(DXF,'0',nl,'ENDSEC',nl,'0',nl,'EOF',nl);
close(dxf);
Writeln;
end; {Konvertiere}
(*---------------------------------------------------------------------
HAUPTPROGRAMM
---------------------------------------------------------------------*)
begin
clrscr;
Writeln('PCX2DXF ',Version);
Writeln;
Writeln('Copyright (c) 1994, 2007 by');
Writeln(' Dipl.-Ing. Martin Vogel');
Writeln(' Stockumer Str. 445');
Writeln(' 44227 Dortmund');
Writeln(' http://www.martinvogel.de');
Writeln;
Writeln('Wandelt eine monochrome PCX-Datei in eine AutoCAD-DXF-Datei um');
Writeln;
Write('Name der PCX-Datei: ');
einname:=paramstr(1);
if einname='' then readln(einname) else writeln(einname);
if einname='' then einname:=dirget('*.PCX');
fsplit(einname,pfad,name,ext);
if ext='' then einname:=einname+'.PCX';
Writeln;
assign(pcx,einname);
reset(pcx,1);
if ioresult<>0 then
begin
writeln('FEHLER: Kann ',einname,' nicht zur Bearbeitung oeffnen.');
halt(1);
end;
pufpos:=maxpuffer+1; {Puffer fuer Lesen der PCX-Datei};
Liesheader;
if (Header.Farbebenen=1) and (Header.bipp=1) and (header.id=10)
then konvertiere
else Writeln('Keine monochrome PCX-Datei! Konvertierung nicht moeglich.');
close (pcx);
writeln;
end.
--
Alles neue gibt's im Blog: Vogels Perspektive
gesamter Thread:
- PCX2DXF - Andreas, 19.09.2007, 07:00 (Software)
- PCX mit Rand - Martin Vogel, 19.09.2007, 17:03
- PCX mit Rand - Martin Vogel
