Topic: Howto horizontally flip a layer's geometry?

[havano]

I have created some geometry in a drawing. Mainly polylines, linear dimensions and texts.
Now I wish to be able to mirror all geometry on a specific layer around a vertical axis (without keeping the original).
I know I could use sendcommands, but I rather wouldn't. Any suggestions? The more simple the better!

[Bryco]

havano, you can use 3dmirror,which doesn't use an axis but a plane.
Here is something that flips things. Adjust it to your needs, download the selectionset function if you dont have one.

Code: [Select]

Sub Flip()
    Dim ss As AcadSelectionSet
    Dim Ent As AcadEntity
    Dim P1, P2, P3
    P1 = ThisDrawing.GetVariable("ucsorg")
    P2 = ThisDrawing.GetVariable("ucsxdir")
    P3 = ThisDrawing.GetVariable("ucsydir")
    Set ss = sset(8, "Specificlayer")
    For Each Ent In ss
        Ent.Mirror3D P1, P2, P3
        Ent.Delete
    Next

End Sub


[Dnereb]

This could work for you:

Code: [Select]

'limited the flipping to drawingspace and also flips entity's on layer with the name as a part of the layer name
Sub MirrorByLayer()
   
   
    Dim FlipLinePoint1 As Variant
    Dim FlipLinePoint2 As Variant
    Dim LayerName As String
    Dim Layer As AcadLayer
    Dim Layers As AcadLayers
    Dim LayerArr() As AcadLayer
    Dim LayerCounter As Long
    Dim AcEnt As AcadEntity
   
   
    FlipLinePoint1 = ThisDrawing.Utility.GetPoint(, "Enter the first point of the mirrorline: ")
    FlipLinePoint2 = ThisDrawing.Utility.GetPoint(FlipLinePoint1, "Enter the second point of the mirrorline: ")
   
    Do While (LayerName = "")
        LayerName = ThisDrawing.Utility.GetString(True, "Enter a (Partial) LayerName or  to flip (000) exits this macro: ")
        If LayerName = "000" Then Exit Sub
        'Finding all legitemate layers
        For Each Layer In ThisDrawing.Layers
            If InStr(1, Layer.Name, LayerName, vbTextCompare) Then
                ReDim Preserve LayerArr(LayerCounter)
                LayerCounter = LayerCounter + 1
                Set LayerArr(LayerCounter - 1) = Layer
            End If
        Next
        'continue loop if no layer was found
        If UBound(LayerArr) = 0 Then LayerName = ""
    Loop
    'find entity's on these layers.
    For Each AcEnt In ThisDrawing.ModelSpace
        For LayerCounter = 0 To UBound(LayerArr)
            'Mirror the bugger
             
            If AcEnt.Layer = LayerArr(LayerCounter).Name Then
                AcEnt.Mirror FlipLinePoint1, FlipLinePoint2
                AcEnt.Delete
                Exit For
            End If
        Next
    Next
       
End Sub

[havano]

Thanks sofar. With your help I wrote this code. But there's something wrong and I can't find out what...

Code: [Select]

Public Sub HorizontalFlip()
'Corrected after Bryco's hint about variable declaration syntax (ver. below).
'Now it works!
Dim Thingy As AcadEntity
Dim LayerName As String
Dim MostLeftX as Double, MostRightX As Double  'thanks Bryco!
Dim BBoxMin, BBoxMax 'variants, will later be specified by GetBoundingBox
Dim FlippointA(0 To 2) as Double, FlippointB(0 To 2) As Double 'thanks Bryco!
MostLeftX = 2147483647: MostRightX = -2147483647

LayerName = "0" 'can be any valid layername

For Each Thingy In ThisDrawing.ModelSpace
    If Thingy.Layer = LayerName Then
        Thingy.GetBoundingBox BBoxMin, BBoxMax
        If BBoxMin(0) < MostLeftX Then MostLeftX = BBoxMin(0)
        If BBoxMax(0) > MostRightX Then MostRightX = BBoxMax(0)
    End If
Next
'I now have MostLeftX and MostRightX for all geometry on layer.
'next, I define the mirror line, halfway between MostLeftX and MostRightX
FlippointA(0) = (MostLeftX + MostRightX) / 2: FlippointB(0) = FlippointA(0)
FlippointA(1) = 0: FlippointB(1) = 1
FlippointA(2) = 0: FlippointB(2) = 0 'endpoints of the vertical mirror line

'finally, I want to horizontally flip all entities on the layer
For Each Thingy In ThisDrawing.ModelSpace
    If Thingy.Layer = LayerName Then
        Thingy.Mirror FlippointA, FlippointB        'thanks Dnereb!
        Thingy.Delete
    End If
Next
End SubWhat am I overlooking?

[Bryco]

Dim FlippointA(0 To 2), FlippointB(0 To 2) As Double
only one of them is a double

[havano]

Thank you so much Bryco!
I immediately reviewed my current project and discovered similar faulty variable declarations. Apparently I got away with them sofar.

[Bryco]

Thanks, and thank you  Berend. The selectionset is not really the way to go.
 

[Dnereb]

No Thx,

It was just a simplified part of something I had laying around with an simple userinterface added.

Have fun to Y'all.