Zobacz temat - Zachowanie oryginalnych rozmiarów w mm po rastrowaniu X4+

Corel FORUM
Forum użytkowników programów firmy Corel. Grafika wektorowa, rastrowa i obróbka zdjęć cyfrowych

Makra - Zachowanie oryginalnych rozmiarów w mm po rastrowaniu X4+

zyzio - 1 Maj 2018, 22:11
Temat postu: Zachowanie oryginalnych rozmiarów w mm po rastrowaniu X4+

Witam. Koledzy ponieważ cały czas do tej pory trzymam się X3 ale chcę sobie dokupić dodatkowo X4, bo otwiera więcej pdf-ów lecz z tego co zauważyłem od tej wersji zmienił się mechanizm wygładzania podczas rasteryzacji, który powoduje zmianę rozmiaru obiektu w mm - teraz dodatkowy wygładzający piksel po obwodzie zostaje dodany na zewnątrz (dokładnie pół piksela z każdej strony), a mi to bardzo nie pasuje ponieważ rastrowane obiekty następnie wielokrotnie powielam na dużym arkuszu drukowym i dochodzi do pomyłek w ostatecznym rozmiarze całego składu.

Zastanawiam się czy dałoby się napisać takie obejście tego problemu czyli makro, które podczas jednego procesu najpierw przypisze do dwóch zmiennych oryginalną wysokość i szerokość zaznaczenia w milimetrach, następnie albo wywoła oryginalne okienko przekształcenia w mapę bitową albo pozwoli wprowadzić te same parametry co w tym okienku ale na customowej formie i w ostatnim etapie przypisze zrastrowanej już bitmapie początkowe rozmiary w milimetrach.

Z góry dzięki jak zawsze

grzjanik - 7 Maj 2018, 15:07
Temat postu: Rozmiar bitmapy

Witam.

U mnie działa. :)

Kod:

'Funkcja opóźniająca od John'a al. "runflacruiser" z forum Oberon'a

Function Wait(sngWaitMax As Single) As Boolean
Dim sngStartTime As Single
sngStartTime = Timer
Do While (Timer - sngStartTime) < sngWaitMax
DoEvents
Loop
End Function

Dalej moje makro

Kod:

Sub BitmapaRozmiarowa()
Dim s As Shape, x#, y#, w#, h#

ActiveDocument.ReferencePoint = cdrBottomLeft
ActiveDocument.Unit = cdrMillimeter

If ActiveSelection.Shapes.count <> 0 Then
ActiveShape.GetBoundingBox x, y, w, h, False

SendKeys "%{B}", True
SendKeys "{.}", True

Do
Wait (1) 'Czas pauzy w sekundach (tutaj pauza powtarzana
dopóki nie zostanie zamknięte okno zamiany na bitmapę)
Loop Until ActiveWindow.Active

ActiveShape.SetPosition x, y
ActiveShape.SetSize w, h

Exit Sub
Else
MsgBox "Brak selekcji!", vbCritical
End If

ActiveWindow.Refresh
Application.Refresh

End Sub

Generalnie makro pobiera położenie i rozmiar obiektu, otwiera okno zamiany na bitmapę, po jego zamknięciu zmienia rozmiar i położenie bitmapy.

Pozdrawiam.
GrzJanik