![]() |
|
#1
|
|||
|
|||
|
hi,
I would like to clone a base shape a few times to get several texts centered on copies of this base shape and each text grouped with its copy of the base shape. The following code used to work on CorelDraw 11: Sub SelectionClone() Dim cdr As CorelDRAW.Application Dim rectdoc As CorelDRAW.Document Dim t As CorelDRAW.Shape Dim t_x As Double, t_y As Double, t_w As Double, t_h As Double Dim r_x As Double, r_y As Double, r_w As Double, r_h As Double Dim shPrice As CorelDRAW.Shape Set cdr = CreateObject("CorelDRAW.Application.12") cdr.CreateDocument.Activate cdr.ActiveDocument.ReferencePoint = cdrTopLeft cdr.ActiveDocument.Unit = cdrPixel cdr.Visible = True Dim shrect As CorelDRAW.Shape, shrectclone As CorelDRAW.Shape ' open base shape file Set rectdoc = cdr.OpenDocument("C:\rectangle.cdr") rectdoc.ActivePage.Shapes.All.CreateSelection Set shrect = ActiveSelection.Clone Set t = cdr.ActiveLayer.CreateArtisticText(0, 0, "9.99") ' does conversions to get the bounding box around a (white) text t.text.ConvertToParagraph t.text.FitTextToFrame t.Fill.UniformColor.ConvertToCMYK t.text.ConvertToArtistic t.Fill.UniformColor.CMYKAssign 0, 0, 0, 0 ' get bounding box around text t.GetBoundingBox t_x, t_y, t_w, t_h ' clone the base shape Set shrectclone = shrect.Clone ' get bounding box around base shape shrectclone.GetBoundingBox r_x, r_y, r_w, r_h ' move base shape to center it on the text shrectclone.PositionX = t_x + (t_w - r_w) / 2 shrectclone.PositionY = t_y + 2 * t_h + (t_h - r_h) / 2 ' group text and base shape shrectclone.CreateSelection t.AddToSelection Set shPrice = cdr.ActiveSelection.Group ' move group cdr.ActiveSelection.PositionX = 0 cdr.ActiveSelection.PositionY = 0 End Sub Now that I have updated CorelDraw to version 12, it doesn't work anymore. When it gets to line Set t = cdr.ActiveLayer.CreateArtisticText(0, 0, "9.99") the shrect variable (holding the first clone of the base shape) is suddenly reassigned so that to point to the text object (t), so the next cloning command does clone text t instead of the base shape. Does anyone know of any changes in VBA so that now this code couldn't work anymore? Hopefully this could be just a problem of bad coding that used to work in the previous version but that has been fixed in the new release. In this case I would like to know where my mistake is and how I could get the same (old) result with a correct coding. I attached a copy of the cdr file that contains the base shape. Thanks Stefano |
|
#2
|
||||
|
||||
|
This is because in CorelDRAW 12, if Clone (or Duplicate) is run on a selection shape, the returned shape is the selection too (but now the cloned/duplicated objects are selected). Because Selection shape has very unique behavior in a sense that there is only one shape of this type per document and it always points to the currently selected shape(s).
Here is an example: Code:
Sub TestSelection()
Dim s1 As Shape
Dim s2 As Shape
ActiveLayer.CreateRectangle 0, 0, 2, 2
Set s1 = ActiveSelection
ActiveLayer.CreateEllipse 2, 2, 8, 4
Set s2 = ActiveSelection
s1.Rotate 10
s2.Rotate 10
End Sub
ActiveSelection.Shapes(1) will give you the first selected shape. In case when there is only one shape in the selection you can use ActiveShape property which is a shortcut to ActiveSelection.Shapes(1): Code:
Sub TestSelection2()
Dim s1 As Shape
Dim s2 As Shape
ActiveLayer.CreateRectangle 0, 0, 2, 2
Set s1 = ActiveShape
ActiveLayer.CreateEllipse 2, 2, 8, 4
Set s2 = ActiveShape
s1.Rotate 10
s2.Rotate 10
End Sub
Here is how you can simplify the above code: Code:
Sub TestSelection3()
Dim s1 As Shape
Dim s2 As Shape
Set s1 = ActiveLayer.CreateRectangle(0, 0, 2, 2)
Set s2 = ActiveLayer.CreateEllipse(2, 2, 8, 4)
s1.Rotate 10
s2.Rotate 10
End Sub
However, if the selection contains more than one shape in it, using ActiveShape is not the correct solution, because it will return just one object (that would be the last object added to the selection). In this case you should use shape ranges. Basically, you can get a range from any shape collection: Code:
Dim sr As ShapeRange Set sr = ActiveSelection.Shapes.All sr.Rotate 10 You can use ActiveSelectionRange method as a shortcut to ActiveSelection.Shapes.All: Code:
Dim sr As ShapeRange Set sr = ActiveSelectionRange sr.Rotate 10 1. If you know for sure that the selection contains only one shape in it, call Clone on the actual shape, not the selection shape: Code:
Dim sClone As Shape Set sClone = ActiveShape.Clone CloneAsRange method which will return the list of cloned shapes as a range: Code:
Dim sr As ShapeRange Set sr = ActiveSelection.CloneAsRange Oh, and one more thing, instead of cloning shapes and then moving the clones, use the optional parameters of Clone/CloneAsRange to specify the offset. Code:
ActiveShape.Clone 0, 0 |
|
#3
|
|||
|
|||
|
Thanks Alex for your really complete (as always) answer.
Stefano |
![]() |
| Currently Active Users Viewing This Thread: 1 (0 members and 1 guests) | |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|