i've got a problem with a macro.
I have old cgm data with old callouts from another designer tool.
The old callouts are know divided into curves, ellipses and text. My goal is to transform it into a new callout.
So my idea is so get the coordinates from the text as the starting point and the coordinate from the ellipses as the the endpoint and make a new callout. The problem is, i can't get the coordinates from the text.
My macro looks like this at the moment:
Sub Macro1() ActiveDocument.Unit = cdrMillimeter Dim sh As Shape Dim shs As Shapes Dim s1 As Shape Dim s2 As Shape Dim OrigSelection As ShapeRange Set shs = ActiveSelection.Shapes()
With ActiveSelection.Ellipse Ex = .CenterX Ey = .CenterY End With With ActiveSelection.Text Tx = .CenterX Ty = .CenterY End With
MsgBox Tx For Each sh In shs.FindShapes(, cdrTextShape) Set s1 = ActiveLayer.CreateCustomShape("Callout", sh.Text.Story, 0, 0.07874, Array(Ex, Ey), Array(128.25, 53.74), 0#, Nothing, 0, 0, False) Set s2 = s1.Custom.TextShape Dim Callout1 As ShapeRange Set Callout1 = ActiveDocument.CreateShapeRangeFromArray(s2, s1) Callout1.SetOutlinePropertiesEx 0.013776, OutlineStyles(0), CreateRGBColor(0, 0, 0), ArrowHeads(90), ArrowHeads(0), cdrFalse, cdrFalse, cdrOutlineRoundLineCaps, cdrOutlineRoundLineJoin, 0#, 100, MiterLimit:=5#, Justification:=cdrOutlineJustificationMiddle Next sh End Sub
Maybe you have an idea.
I must confess that I still do not understand what you need.
Maybe if you will focus on the document page instead of Object Manager, I would... I do not see any S11M on the Object Manager picture. Is that blue rectangle the one named 'Kontrollrechteck'? Even if Yes, what else is selected?
It sounds to me that you want to identify (1) the text shape and (2) one of the ellipses, and then get information from those shapes that you can use to create a callout.
Dim sr As ShapeRange
Dim sEllipse As Shape
Dim sText As Shape
Set sr = ActiveSelectionRange
Set sEllipse = sr.Shapes.FindShape(, cdrEllipseShape)
Set sText = sr.Shapes.FindShape(, cdrTextShape)
MsgBox "Ellipse: CenterX = " & sEllipse.CenterX & ", CenterY = " & sEllipse.CenterY & vbCrLf & "Text: CenterX = " & sText.CenterX & ", CenterY = " & sText.CenterY & vbCrLf & "Text string = " & sText.Text.Story.Text
That looks like this:
That is just getting one of the ellipses, and I am assuming that it doesn't matter which one you use, as they both have the same center location.
Instead of using FindShape (returns a shape), you could use FindShapes (returns a shaperange) with queries to perform more sophisticated searches.
Thx. I will try it. It looks great.
Thx for the help. It works perfectly!