Umrisslinie vektorisierte Grafik

[lex2k6]

Hallo zusammen,

ich musste eine Grafik für eine Arbeit vektorisieren und das Ergebnis ist ansich ganz schön geworden. Ich habe das Bild
(EPS-File) nun in Corel Draw X4 geöffnet und leider zwischen den einzelnen Flächen weiße Ränder (siehe angehängtes Bild, stark vergrößerter Ausschnitt). Weiß jemand Rat, um dies zu beheben? Ich könnte natürlich jedem Objekt eine Umrisslinie mit der entsprechenden Farbe zuweisen, allerdings wäre ich da von Hand wohl einige Tage beschäftigt ... Geht das auch automatisiert oder gibt es zu diesem Problem eine andere Lösung?

vielen dank schon mal



Irgendwie wird das Bild nicht angezeigt. Hier der Direktlink: http://img163.imageshack.us/img163/6880/...nntozq.png

[Helmut]

und das Ergebnis ist ansich ganz schön geworden.

hmmm, also das schaut eher nach Flickenteppich als nach Grafik aus. Wärst Du da nicht besser gekommen das selbst zu zeichnen?

So aufwendig scheint das ja nicht zu sein?

Cu Helmut

[lex2k6]

Das Bild ist nur ein sehr kleiner und vergrößerter Teil des Bildes um klar zu machen, was ich mit den Umrisslinien meine. Das gesamte Bild ist um einiges größter und detailreich, von daher seh ich keine Chance, das in angemessener Zeit von Hand nachzuzeichen...

[Nachtviole]

Hallo lex2k6!

So etwas kann man gut von einem Makro erledigen lassen. Ich habe mal eine CorelDraw x3 –Datei erstellt welche ein einfaches Makro enthält was das kann. Öffne die Datei, ev. kommt eine Warnmeldung das ein Makro enthalten ist, dann müßtest Du auf „Makro aktivieren“ gehen sonst geht’s nicht (das Rechteck in der Datei kannst Du löschen). Kopiere nun Deinen Flickenteppich dort hinein, versehe alle Objekte mit einem Umriß z.B. Haarlinie schwarz, löse über „Anordnen / Gruppierung auflösen“ die Gruppe auf und markiere alle Objekte.
Nun gehe auf „Extra / VisualBasic / Abspielen“ woraufhin sich ein Dialog öffnet.



Wähle dort bei „Makros in:“ – „VBAProjekt (Macro)“ aus, da nur ein Makro „umriss.Macro1“ vorhanden ist, ist dieses schon ausgewählt und klicke auf „Ausführen“. Nun brauchst Du etwas Geduld denn das Makro arbeitet jedes Objekt ab. Wenn das Skript fertig ist haben alle Umrisse die Farbe der (einfarbigen) Füllung, Du kannst bei Bedarf die Linienstärke noch erhöhen, aber ich denke Haarlinie reicht aus.
Das Makro habe ich für X3 erstellt und hoffe, daß es auch unter X4 funktioniert. Unten habe ich mal den Code des Makros eingefügt.

Viele Grüße von der Nachtviole!

Code:

Sub Macro1()
Dim Auswahl As ShapeRange

Set Auswahl = ActiveSelectionRange
For i = 1 To Auswahl.Count
    If Auswahl(i).Outline.Type > cdrNoOutline And Auswahl(i).Fill.Type = cdrUniformFill Then
        Auswahl(i).Outline.Color = Auswahl(i).Fill.UniformColor
    End If
Next i
End Sub

[Blacky]

Hi Nachtviole...

Hab' mir dein Makro genommen und damit gearbeitet.
Klappt auch wunderbar in X5.
Hätte so ein Makro schon des Öfteren gebraucht, aber jetzt habe ich eines. Danke! :daumen:
Auch mit 2787 Objekten kein Problem. (Anhang)

[Nachtviole]

Hallo Franz!

Es freut mich, daß Dir das Makro etwas nützt, aber auch, daß es unter X5 läuft. Zur Zeit bastel ich gerade an ein paar ausführlicheren Makros (mit Dialog) welche dann möglichst auch unter X5 laufen sollten.

Viele Grüße von der Nachtviole!

[lex2k6]

Wow, super ... vielen Dank, das hat mir (und wahrscheinlich auch Anderen) einiges an Arbeit erspart!

[SaltyDog]

Ich habe versucht dieses Makro auch in Corel X7 zu nutzen, da dort leider das Problem immernoch besteht. Leider funktioniert es nur bei wenigen Objekten. sobald es etwas mehr Objekte werden wird CorelDraw inaktiv. Hat da jemand einen Lösungsansatz. Ich schaffe es leider nicht das Problem zu beheben. Ich habe aber auch leider überhaupt keinen Plan von Makros :/

Edit:
Sorry das ich diesen Thread nochmal aufgemacht habe! Ich hatte einefach nur sehr sehr viele Objekte und es hat ca eine halbe Stunde gedauert. Dieses Makro funktioniert auch unter Corel Draw X7 noch einwandfrei!

Vielen Dank für das Teilen dieses Makros!

Grüße

Salty

[grafikworks]

versuche doch mal ein paar Objekte in neue Seiten zu erstellen und dann das Macro testen.
Die Objekte selbst lassen sich ja später kopieren und in die Hauptseite einfügen.

[koter]

Hallo Salty,

...es hat ca eine halbe Stunde gedauert...

Bei langen Ausführungszeiten kann es sich lohnen, die Optimierung einzuschalten:

Code:

Sub Macro1()
    Dim Auswahl As ShapeRange
    
    Set Auswahl = ActiveSelectionRange
    Call zeitMessung(True) ' Zeitmessung, kann gelöscht werden
    Optimization = True ' Optimierung einschalten
    For i = 1 To Auswahl.Count
        If Auswahl(i).Outline.Type > cdrNoOutline And Auswahl(i).Fill.Type = cdrUniformFill Then
            Auswahl(i).Outline.Color = Auswahl(i).Fill.UniformColor
        End If
    Next i
    Optimization = False 'Optimierung ausschalten
    ActiveWindow.Refresh ' Bildschirm auffrischen
    Call zeitMessung ' Zeitmessung, kann gelöscht werden
End Sub

Sub zeitMessung(Optional start As Boolean)
    Static t1
    If start Then
        t1 = Time
    Else
        MsgBox Format(Time - t1, "hh:mm:ss")
    End If
End Sub

Bei einem Test brauchte das Makro ohne Optimierung 1:33 Minuten.
Mit Optimierung brauchte es nur 6 Sekunden.

Die Sub zeitMessung und die Befehle zum Aufruf derselben kannst Du löschen, Sie dienen nur zum Experimentieren.

Gruß

Koter