Hi guys,
I'm kinda stuck on thisone. I've been coding a magnifier glass macro, which works quite okay for the moment. Only thing, I cannot figure out how to do, is to set the background to non-transparent within the lens, that I use for magnification.
Here's the code I've come up with so far:
Public Sub lupeNeu() Dim s1 As shape, s2 As shape, s3 As Effect, s4 As ShapeRange, s5 As shape Dim l1 As Layer Dim Shift As Long Dim x1 As Double, y1 As Double, x2 As Double, y2 As Double '***** New Layer If Not LayerExists("Lupen") Then ActivePage.CreateLayer ("Lupen") Set l1 = ActivePage.Layers("Lupen") '***** no more used 'Set s1 = ActivePage.Layers("Abbildung").FindShape(, cdrBitmapShape) '***** Define glass size and origin ActiveDocument.GetUserArea x1, y1, x2, y2, Shift, 100, False, cdrCursorSmallcrosshair '**** Store the origin xSafe = x1 ySafe = y1 '***** Create magnified lens Set s2 = ActiveLayer.CreateEllipse2(x1, y1, calcDist(x1, y1, x2, y2)) Set s3 = s2.CreateLens(cdrLensMagnify, 3) s3.Lens.Freeze '***** Define the drag-out location ActiveDocument.GetUserArea x1, y1, x2, y2, Shift, 100, False, cdrCursorSmallcrosshair '***** Move the lens out there Set s4 = s3.Lens.Shapes.All s4.Move x2 - xSafe, y2 - ySafe '***** Create a callout-style-line Set s5 = l1.CreateLineSegment(xSafe, ySafe, x2, y2) s5.OrderToBack End Sub
So far, everything I came up with ended in errors. Any help would be appreciated.
EDIT:
Sorry for the inconvenience guys. Here's the missing two custom functions missing:
Public Function LayerExists(ByVal strLayerName As String) As Boolean ' This function will return true if the layer name passed exists Dim objLayer As Layer On Error Resume Next Set objLayer = ActivePage.Layers(strLayerName) LayerExists = Not objLayer Is Nothing End Function Public Function calcDist(x1 As Double, y1 As Double, x2 As Double, y2 As Double) As Double Dim returner As Double returner = Math.Sqr((x1 - x2) ^ 2 + (y1 - y2) ^ 2) calcDist = returner End Function
Below are the two results I'm getting.
Macro:
Created manually:
When I compare the values in the lens docker on both of them, I cannot see any difference. Both use the "freeze" method.
But somehow the background is opaque when created manually, but it is transparent, when created with the macro.
I've checked the Color and FillColor properties for the EffectLens class, but those are not applicable for the magnifying lens.
Same goes for the additional color parameters in the CreateLens method - except if I missed some obscure settings there, that is.
It might be as easy as the ellipse shape (s2) not having a (uniform color) fill when you create it in the code whereas the manually created ellipse shape uses the default settings for fill and outline (resulting in a white filled shape in your case).