CorelDraw és a makrozás

A CorelDRAW az egyik legjobban automatizálható vektoros program. Gyakorlatilag mindent meg tudsz írni kódból, amit kézzel is rajzolnál.

3 szinten lehet automatizálni

**1. VBA - a beépített megoldás**

Ez a klasszikus. Van saját makró szerkesztője, recorder-e, és a legtöbb példakód is ebben van írva.

`Tools > Macros > Macro Manager` alatt találod.

**2. VSTA - C# és VB.NET**

Ugyanaz az objektum modell, csak Visual Studio-val. Akkor érdemes, ha nagyobb bővítményt írnál. A Corel leírása szerint is ezt a kettőt támogatja hivatalosan: VBA vagy VSTA.

**3. Külső COM automatizálás - pl. Python**

A CorelDRAW COM objektumként fut a Windowsban, tehát kívülről is vezérelheted Pythonból, C#-ból, stb. `CorelDRAW.Application` néven éred el.

A teljes objektum modellhez van részletes referencia, diagramok, mintakódok a Developer oldalon.

Mit tudsz így rajzolni?

Az objektum modell: `Application > Document > Page > Layer > Shape > Curve > Node`

Minden alakzatot tudsz kódból létrehozni. A legalapabb parancs például:

> `Set s1 = ActiveLayer.CreateRectangle`... ez hozza létre a téglalapot, az első 4 paraméter a bal, alsó, jobb, felső koordináta.

De van `CreateEllipse`, `CreatePolygon`, `CreateCurve`, `CreateArtisticText` is.

Mire használják a legtöbben:

* rácsok, perforációk, 1000+ furat / címke paraméteresen

* CSV / Excel-ből adatvezérelt rajzolás - pl. 500 névjegykártya, árcímke, sorszámozás

* lézer / CNC előkészítés: kontúrok rendezése, hézag zárás, DXF cleanup

* batch export, PDF generálás, vonalkód / QR

Példa 1: VBA makró - rács rajzolás

Másold be a Macro Editorbe (`Tools > Macros > Visual Basic Editor`):

```vba

Sub RajzolRacs()

Dim x As Double, y As Double

Dim doc As Document: Set doc = ActiveDocument

doc.Unit = cdrMillimeter ' állítsd mm-re, alapból inch

For x = 0 To 200 Step 20

For y = 0 To 200 Step 20

' téglalap bal, fent, jobb, lent

ActiveLayer.CreateRectangle x, y, x + 10, y + 10

Next y

Next x

End Sub

```

Felvétel is működik:
`Tools > Macros > Start Recording`, rajzolsz kézzel, Stop, és megnézheted milyen kódot generált.

Csak a recorder elég buta, kézzel érdemes letisztítani.

Példa 2: Görbe pontokkal

```vba

Sub RajzolGorbe()

Dim crv As Curve

Dim seg As Segment

Set crv = ActiveLayer.CreateCurve

' 2 pont közötti vonal

crv.CreateSubPath 0, 0

crv.AppendLineSegment 50, 50

crv.AppendLineSegment 100, 0

ActiveLayer.CreateCurve crv

End Sub

```

Példa 3: Pythonból vezérelve

Ha nem akarsz VBA-zni:

```python

import win32com.client

app = win32com.client.Dispatch("CorelDRAW.Application")

app.Visible = True

doc = app.ActiveDocument

layer = doc.ActivePage.ActiveLayer

# 10x10-es négyzet 20,20-nál

layer.CreateRectangle 20, 20, 30, 30

```

Gyors tippek

* **Koordináta rendszer:** alapból a bal alsó sarok a 0,0 és inch-ben mér. Az első dolgod legyen `ActiveDocument.Unit = cdrMillimeter`.

* **GMS fájl:** a makróidat ide menti: `...AppData\Roaming\Corel\CorelDRAW Graphics Suite\GMS`

* **Biztonság:** ha nem fut a makró, `Tools > Options > Workspace > Macros` alatt engedélyezd.

Könyvtárban levő összes képállományok logo hozzáadása

Másik klasszikus kötegelt feladat CorelDRAW-ban. Ez a legstabilabb verzió - végigmegy egy mappán, és minden képre jobb alul ráteszi a logót.

PNG logót javaslok logo.png néven átlátszó háttérrel, de működik JPG-vel is.

A makró - másold egyben

Tools > Macros > Visual Basic Editor > GlobalMacros > Modules > New Module és illeszd be:

Sub LogoBatch_2025_OK()

Dim fso As Object, file As Object

Dim sourceFolder As String, logoPath As String, outFolder As String

sourceFolder = "C:\Users\User\Downloads\__html\kep\foto"

logoPath = "C:\Users\User\Downloads\__html\kep\logo.png"

outFolder = "C:\Users\User\Downloads\__html\kep\foto\keszen"

Set fso = CreateObject("Scripting.FileSystemObject")

If Not fso.FolderExists(outFolder) Then fso.CreateFolder outFolder

For Each file In fso.GetFolder(sourceFolder).Files

If LCase(fso.GetExtensionName(file.Name)) = "jpg" Or LCase(fso.GetExtensionName(file.Name)) = "png" Then

WatermarkOne_Open file.Path, logoPath, outFolder & "\" & fso.GetBaseName(file.Name) & "_logo.jpg"

End If

Next file

MsgBox "Kész!"

End Sub

Private Sub WatermarkOne_Open(imgPath As String, logoPath As String, savePath As String)

Dim doc As Document

Dim bg As Shape, lg As Shape

Dim w As Double, h As Double

Dim logoLayer As Layer

Set doc = Application.OpenDocument(imgPath)

doc.Unit = cdrMillimeter

Set bg = doc.ActivePage.ActiveLayer.Shapes(1)

w = bg.SizeWidth

h = bg.SizeHeight

' 2025-ben így kell lapméretet állítani:

doc.ActivePage.SetSize w, h

bg.LeftX = 0

bg.BottomY = 0

bg.OrderToBack

' Új réteg és aktiválás 2025-ös módszerrel

Set logoLayer = doc.ActivePage.CreateLayer("LOGO")

logoLayer.Activate

'---

' doc.ActiveLayer.Import logoPath

' Set lg = doc.ActiveLayer.Shapes(1)

' lg.SetSize w * 0.2, w * 0.2 * (lg.SizeHeight / lg.SizeWidth)

' lg.RightX = w - 3

' lg.BottomY = 3

'---

doc.ActiveLayer.Import logoPath

Set lg = doc.ActiveLayer.Shapes(1)

' --- JAVÍTÁS: fix méret + aránytartás ---

Dim origW As Double, origH As Double

origW = lg.SizeWidth

origH = lg.SizeHeight

' Ha négyzetes a logód, ez 15mm lesz, nem fog torzulni

Dim finalSize As Double: finalSize = 10 ' mm

If origW > origH Then

lg.SizeWidth = finalSize

lg.SizeHeight = finalSize * origH / origW

Else

lg.SizeHeight = finalSize

lg.SizeWidth = finalSize * origW / origH

End If

lg.RightX = w - 3

lg.BottomY = 3

doc.Export savePath, cdrJPEG

doc.Close

End Sub

Hogyan használd

Tedd a logo.png-t egy fix helyre.
A kódban felül írd át a 3 útvonalat: sourceFolder, logoPath, outFolder.
Futtatás: Tools > Macros > Macro Manager > LogoBatchWatermark > Run.

Mit csinál pontosan:

Létrehoz egy új dokumentumot minden képhez.
A lapot a kép méretére állítja.
Importálja a logót, átméretezi a kép szélességének 15%-ára hogy minden képen arányos legyen.
RightX és BottomY alapján betolja jobb alsó sarokba 5mm margóval.
Exportálja kepneve_logo.jpg néven és bezárja.

IT, BI, DWH, DM, AI

Keresés ebben a blogban