Corel Draw Bohrlöcher und EstlCam

Hallo zusammen,

dies mal ein kommisches Problem und meine Lösung.

Das Problem:
Wenn ich mit CorelDraw X8 Bohrlöcher zeichnen möchte, mache ich dies über die normale Elipsenfunktion und setzte die Höhe und Breite gleich groß.
So weit ja auch kein Problem später in EstlCam (10.047 aktuell).

Wenn ich aber bsp. dieses Bohrloch nun über die Änderungsfuntion 'Position' um einen bestimmten Abstand vervielfälltigen möchte, so sind später alle Bohrlöcher in EstlCam nicht mehr als Bohrlöcher ansprechbar, sondern nur als Kreise (daran zu erkennen, dass die Markierung nur an der Außenlinie des Kreises sich fängt und auch der Kreis kein innenliegendes Kreis mehr hat.)

Meine Lösung:
Da ich programmieren kann, habe ich kurzerhand den Makrorekorder angeschmissen und die folgende Aktion mal aufgezeichnet.

1. Die alten XY-Positonen handschriftlich notiert
2. Einen neuen Kreis wie gehabt eingefügt
3. Den alten Kreis gelöscht
4. Die alte XY-Position eingestellt
5. Den neuen/alten Durchmesser eingestellt.
6. Aufzeichnung beendet.

Anschließend noch mal das ganze testweise durchlaufen lassen, analysiert und in eine schönere konfortablere Form gebracht incl. Code-Kommentaren.

Hier nun mein Ergebnis:

Sub Bohrkreis_umwandeln()

' Herkunft: Durch Markorekorder aufgezeichnet und angepasst

' Variablen deklarien
Dim OrigSelection As ShapeRange ' Originalkreis
Dim S1 As Shape ' Neuer Kreis
Dim XPosAlt As Double ' Alte X-Position
Dim YPosAlt As Double ' Alte Y-Position
Dim AlterXRadius As Double ' Alter X Radius
Dim AlterYRadius As Double ' Alter Y Radius
Dim NeuerXRadius As Double ' Neuer X Radius
Dim NeuerYRadius As Double ' Neuer X Radius

Const Radius1mm As Double = 0.019685 ' pro 0,1 mm
Const Linienstärke As Double = 0.003937 ' pro 0,1 mm

' Den Originalkreis in einer Variablen sicherm
Set OrigSelection = ActiveSelectionRange
AlterXRadius = OrigSelection.SizeWidth / 2 / Radius1mm
AlterYRadius = OrigSelection.SizeHeight / 2 / Radius1mm

' MsgBox "Alter X Radius " & AlterXRadius & vbCrLf & "Alter Y Radius " & AlterYRadius & vbCrLf

' Die Position des alten Kreises merken
XPosAlt = OrigSelection.PositionX
YPosAlt = OrigSelection.PositionY

' Die neue Breite und Höhe abfragen. Alter Wert gilt als Vorschlag
NeuerXRadius = InputBox("Wie groß soll der X Radius sein?", "Neuer X - Radius", AlterXRadius)
NeuerYRadius = InputBox("Wie groß soll der Y Radius sein?", "Neuer Y - Radius", AlterYRadius)

' Den neuen Kreis an der alten XY-Position zeichnen mit neunem/alten Radius
Set S1 = ActiveLayer.CreateEllipse2(XPosAlt, YPosAlt, NeuerXRadius * Radius1mm, NeuerYRadius * Radius1mm)

' Keine Füllfarbe
S1.Fill.ApplyNoFill

' Die Aussenlinie bestimmen 0,2mm dick (allen anderen Werte für Farbe, Linienart usw, sind Standard
S1.Outline.SetPropertiesEx 2 * Linienstärke, OutlineStyles(0), CreateCMYKColor(0, 0, 0, 100), ArrowHeads(0), ArrowHeads(0), cdrFalse, cdrFalse, cdrOutlineButtLineCaps, cdrOutlineMiterLineJoin, 0#, 100, MiterLimit:=5#, Justification:=cdrOutlineJustificationMiddle

' Den Mittelpunkt des Kreises setzen: Zentriert
ActiveDocument.ReferencePoint = cdrCenter

' Alten Kreis löschen
OrigSelection.Delete

End Sub

Einbinden dieser Funktion (Sub) in CorelDraw X8
1. Menüpunkt "Extras, Makros, Makromanager" aufrufen (oder ALT+Umschalt+F11) anklicken/drücken
2. Unter "Visual Basic für Application, GlobalMacros, RecordedMacros" einen Rechtsklick und dann auf "Neuer Makro" klicken
3. Rechtsklick auf das neue Makro "Makro1" klicken und bearbeiten auswählen
4. Nun o. g. Code (von Sub xx bis End Sub) einfügen (alter Eintrag Sub Macro1() End Sub kann gelöscht werden)
5. In der Übersicht des Makromanagers erscheint nun die neue Funktion (Sub)

Wenn die Bezeichnung "Bohrkreis_umwandeln" nicht passt, der muss dies in der ersten Zeile der Funktion (Sub) tun. Aber bitte keine Leerzeichen und am besten auch keine Umlaute und auch keine Sonderzeichen benutzen. Leerzeichen können durch einen Unterstrich genutzt werden (so wie bei mir).

Wie benutze ich nun die Funktion (Sub)?
1. Den Makromanager ggf. aufrufen (siehe oben)
2. Den betroffenen Kreis markieren/anklicken
3. Per Doppelklick auf die Funktionsbezeichnung diese starten
4. Es erfolgen nun 2 Eingabeboxen (inputbox), in denen der alte Durchmesser angezeigt wird. Der Wert, der dort angezeigt wird, ist der des alten Kreises, Durch drücken der Entertaste, kann dieser bestätigt werden oder durch einen neuen ersetzt werden.
4.1 Gibt man 2 unterschiedliche Werte ein, so entsteht eine Elipse (da ein Kreis ja eigentlich eine Elipse ist)
5. Nach dem bestätigen der beiden Eingaben ist an der alten XY-Position der neue Kreis gesetzt worden und der alte gelöscht.

Da es hier nur um Bohrlöcher geht, habe ich die Linienstärke auf 0,2 mm gelassen, Sie kann zwar in Code angepasst werden, dies ist aber eigentlich nicht nötig.

So, wer auch die gleichen Probleme hat, der hatte Sie hiermit nun.

Viel Spaß beim ausprobieren.

Gruß

Volker