VBA Ecken eines Objekts abrunden

[Olaf]

Hallo,

ich möchte in Corel per VBA Code die Ecken eines Zeichenobjekts (Rechteck) abrunden falls gewünscht.

Die Ecken sollen um einen Radius in mm abgerundet werden der in eine Textbox eingetragen wird

Leider konnte ich nicht herausfinden wie ich in VBA den Radius benennen kann.


Rechteck.SizeRadius = Textbox5.Text


Das ist natürlich nicht richtig aber so ähnlich stelle ich es mir vor, nur das mir die Begriffe für den Radius fehlen.

Vielleich hat ja jemand eine Idee.

Vielen Dank und ein schönes Wochenende.

Gruß

Olaf

[Litschi]

Vielleicht hilft Dir das weiter
https://www.oberonplace.com/vba/drawmacr...nerssh.htm

[koter]

Hallo Olaf,

wenn Du das Makro aus Litschis Beitrag verwenden willst, musst Du das Rechteck vorher in eine Kurve wandeln.

Wenn es ein Rechteck bleiben soll, kannst Du laut VBA-Hilfe dieses Makro verwenden:

Code:

Sub Test()
   ActiveShape.Rectangle.SetRadius 0.3
End Sub

Seit einigen Versionen (ich glaube seit X4) funktioniert das bei mir aber nicht mehr.
Vielleicht hat Corel diesen Bug inzwischen entfernt und bei Dir läuft es.
Ein Textfeld gibt eine Zeichenkette zurück. Du musst diese vorher in eine Zahl wandeln.

Falls es nicht klappt, melde Dich noch einmal.

Gruß

Koter

[Olaf]

Hallo Koter,

vielen dank für Deine Antwort, ich werde es die Tage mal ausprobieren, wenn das klappt wäre das toll, ansonsten werde ich es mit verschiedenen Vorlagen lösen die dann schon gerundet sind.

Ich wünsche Dir einen guten Start in die Woche.
Gruß

Olaf

[koter]

Hallo Olaf,

...ansonsten werde ich es mit verschiedenen Vorlagen lösen die dann schon gerundet sind....

Du kannst es noch mit dieser Prozedur versuchen:

Code:

Sub RechteckAbrunden(R As Shape, Optional Radius As String, Optional EckeLO As String, _
   Optional EckeRO As String, Optional EckeRU As String, Optional EckeLU As String)
   Dim Rechteck As Rectangle 'die Rechteck-Eigenschaften des Zeichenobjekts
   If R.Type = cdrRectangleShape Then 'prüfen ob es sich um ein Rechteck handelt um Fehler zu vermeiden
       R.CreateSelection 'Das Rechteck auswählen (das muss leider sein)
       Set Rechteck = R.Rectangle
       If Val(Radius) > 0 Then
           If EckeLO = "" Then EckeLO = Radius
           If EckeLU = "" Then EckeLU = Radius
           If EckeRO = "" Then EckeRO = Radius
           If EckeRU = "" Then EckeRU = Radius
       End If
       With R.Rectangle
           .RadiusUpperLeft = Val(EckeLO)
           .RadiusUpperRight = Val(EckeRO)
           .RadiusLowerLeft = Val(EckeLU)
           .RadiusLowerRight = Val(EckeRU)
       End With
   End If
End Sub

Als erstes Argument muss das zu verarbeitende Rechteck stehen. Wird (nur) das zweite Argument angegeben, werden alle Ecken abgerundet. Die anderen Argumente betreffen die einzelnen Ecken von links oben weiter im Uhrzeigersinn.

Beispiele:


Die Prozedur verarbeitet auch Zeichenketten. Call RechteckAbrunden(Rechteck, TextBox1.Text) sollte also auch funktionieren.

Gruß

Koter

[Olaf]

Hallo Koter,

sorry das ich so spät Antworte, ich werde das  in Kürze ausprobieren, ich habe derzeit leider noch ein paar andere Baustellen und komme derzeit nicht dazu.

Ich Danke Dir und wünsche Dir ein schönes Wochenende

Gruß


Olaf

[Olaf]

Hallo Koter,

veilen Dank nochmals für Deine Hilfe. Leider bin erst vor 2 Tagen dazu gekommen Deine Prozedur zu testen. Bei mir funktioniert es leider noch nicht. Es liegt aber sicherlich an mir bzw. am Aufbau den ich schon im Modul habe.

Zur Sicherheit füge ich auch einmal den bestehenden Code aus unserem Plattenmodul ein.

- Das Rechteck bei dem ich den Eckenradius verändern möchte ist das Objekt oVorderseite
- Den Radius in mm möchte ich aus der Textbox3 aus dem Dialog holen
- Es reicht aus wenn immer alle Ecken mit dem gleichen Radius gerundet werden

Code:

Option Explicit

'Globale Variablen (sind auch aus anderen Modulen aufrufbar)
Public Breit As Double 'Breit sei eine Gleitkommazahl mit doppelter Genauigkeit
Public Hoch As Double 'Breit sei eine Gleitkommazahl mit doppelter Genauigkeit
Public Dateiname As Double
Public Anzahl As Double

' lokale Variablen (gelten nur in diesem Modul)
Private oSeite As Page 'das Objekt "oSeite" sei eine Seite im Dokument
Private oPlattenEbene As Layer 'das Objekt "oPlattenEbene" sei eine Ebene

Private oVorderseite As Shape ' das Objekt "Vorderseite" sei ein Zeichnungsobjekt

Public Sub Start()
   Call VarINI 'Variablen initialisieren
   Dialog1.Show 'Dialog anzeigen
End Sub

Private Sub VarINI()
   'die Maßeinheit des Dokuments auf Millimeter setzen
   ActiveDocument.Unit = cdrMillimeter
   
   'Zuweisung der Ojekte an die Objektvariablen:
   'die Objektvariable "oSeite" enthält die Aktive Seite
   Set oSeite = ActivePage
   
   'die Objektvariable "oPlatten" enthält die Ebene "Platten" auf der Seite "oSeite"
   Set oPlattenEbene = oSeite.Layers("Platten")
   
   'die Objektvariable "oPlatten" enthält die Zeichnungsobjekte "Boden","Seitenplatte VH"
   'und "Seitenplatte LR" auf der Ebene "oPlatten"

   Set oVorderseite = oPlattenEbene.Shapes("Vorderseite")

   'die Globalen Variablen mit Werten füllen
   
   Breit = oVorderseite.SizeWidth
   Hoch = oVorderseite.SizeHeight
   
End Sub

Sub machPlatten(Optional B As Boolean)
   If Not Dialog1.Visible Then Exit Sub ' nicht ausführen wenn der Dialog nicht sichtbar ist
   
   Call PlattenAusrichten 'Die Platten ausrichten
   Call machVorderseitePlatte
   
End Sub

Private Sub machVorderseitePlatte()

   'ändert die Maße der Vorderseite
   'Breite und Höhe der Vorderseite ändern
   oVorderseite.SizeWidth = Breit
   oVorderseite.SizeHeight = Hoch
   
End Sub

Private Sub PlattenAusrichten() 'richtet die Platten auf der Seite aus

   oVorderseite.CenterX = oSeite.CenterX
         
End Sub

Sorry, aber ich habe da bisher immer noch zu wenig Erfahrung um die Prozedur von Dir professionell umzusetzen.

Gruß

Olaf

[koter]

Hallo Olaf,

leider kann ich aus Deiner Beschreibung nicht erkennen, was nicht funktioniert.
Du müsstest genau beschreiben welcher Fehler wo und wann eintritt.

Du kannst mir aber auch die Datei (wie immer für die Version X7) schicken.
Dann schaue ich wo es klemmt.

Gruß

Koter

[koter]

Hallo Olaf,

ich habe die Datei erhalten.

Die Prozedur aus Beitrag 5 verarbeitet Rechtecke. Das Objekt „oVorderseite“ ist aber kein Rechteck sondern eine rechteckige Kurve. Es konnte also nicht funktionieren.

Ich werde morgen oder übermorgen eine Prozedur schreiben, die rechteckige Kurven verarbeitet. Heute schaffe ich das nicht mehr.

Gruß

Koter

[Olaf]

Hallo Koter,

vielen Dank das Du Dir die Zeit genommen hast. Wenn es das Makro und das was das Makro kann zulässt darf ovorderseite gerne ein Rechteck sein, das spielt für mich keine Rolle.

Ich kriege es aber leider trotzdem nicht hin mit der Prozedur, der Debugger bemängelt "Call Rechteckabrunden" mit der Fehlermeldung "Argument ist nicht optional".

Gruß

Olaf