Apagada docs

Macro para CorelDraw que permite:

1. Ordenar todos los objetos del dibujo en forma de cuadrícula, con un ancho dado (los objetos se solapan). Sub organizaobjetos (columnas).
2. Ordenar todos los objetos en forma de abanico (los objetos se solapan). Sub abanicoobjetos(columnas. filas).
3. Desordenar todos los objetos, creando una imagen caótica. Sub desordenaobjetos().

Esta macro produce mejores resultados si los objetos son imágenes en miniatura. Yo lo empleé con las imágenes en miniatura de las portadas de los periódicos de un día.

Attribute VB_Name = "ArrangeObjects"
Option Explicit
 
'
' Arranges al objects in a rectangular ruler shape,
'   cols objects width.
'
' Organiza todos los objetos en forma de cuadrícula
'   con cols objetos de ancho.
'
Sub organizaobjetos(cols As Integer)
    'anchoX: visible object width. saltoY: visible object height.
    Dim anchoX As Double, saltoY As Double
    'next object X and Y coordinates.
    Dim nuevoX As Double, nuevoY As Double
    'object reference
    Dim cosa As Layer
 
 
    If cols = 0 Then cols = 10
    anchoX = ActiveDocument.SizeWidth / cols
    saltoY = ActiveDocument.SizeHeight / 9
    nuevoX = 0: nuevoY = 0
 
    For Each cosa In ActiveDocument.Layers
        'cosa.Move cosa.PositionX - NuevoX, cosa.PositionY - NuevoY
        'cosa.SetPosition NuevoX + (cosa.SizeWidth / 2), nuevoy + (cosa.SizeHeight / 2)
 
        'You can't move anything to the same position
        If (cosa.PositionX <> nuevoX) Or (cosa.PositionY <> nuevoY) Then
            cosa.SetPosition nuevoX, nuevoY
        End If
        nuevoX = nuevoX + anchoX
 
        If nuevoX >= ActiveDocument.SizeWidth Then
            nuevoX = 0
            nuevoY = nuevoY + saltoY
            If nuevoY > ActiveDocument.SizeHeight Then
                nuevoY = 0
            End If
        End If
    Next
End Sub
 
'Arranges objects in a fan shape
'  rows and cols determine the number of fans
'  (original aim was displaying 100 objects).
'
'Reubica objetos en forma de abanico
'  rows y cols (filas y columnas) determinan el número
'  de abanicos (la idea inicial era recolocar 100 objetos)
'
Sub AbanicoObjetos(cols As Integer, rows As Integer)
    Dim cosa As Layer  'Object layer.
    Dim anchoX As Long 'widthX
    Dim altoY As Long  'heightY
    Dim nuevoX As Long 'new X after movement
    Dim nuevoY As Long 'new Y after movement
    Dim anguloMin As Double 'Min angle.
    Dim anguloMax As Double 'Max angle.
    Dim anguloDelta As Double 'Angle Difference between objects.
    Dim angulo As Double      'Current angle
    Dim Visibility As Boolean 'Visible object?
    anguloMax = 0
    anguloMin = 360 - 15
    anguloDelta = -15
    anchoX = ActiveDocument.SizeWidth / cols
    altoY = ActiveDocument.SizeHeight / rows
    nuevoX = anchoX / 2
    nuevoY = altoY / 2
    angulo = anguloMin
    Visibility = True
 
    'normalize angles...
    If anguloMax < 0 Then anguloMax = (anguloMax Mod 360) + 360
    If anguloMax > 360 Then anguloMax = anguloMax Mod 360
    If anguloMin < 0 Then anguloMin = (anguloMin Mod 360) + 360
    If anguloMin > 360 Then anguloMin = anguloMin Mod 360
    'if delta is positive, max should be bigger than min,
    '  and vice versa.
    If Sgn(anguloMax - anguloMin) <> Sgn(anguloDelta) Then
        'swap anguloMax, anguloMin
        angulo = anguloMax
        anguloMax = anguloMin
        anguloMin = angulo
    End If
 
    For Each cosa In ActiveDocument.Layers
        'debug
         'cosa.Visible = True
 
        If (Int(cosa.PositionX) <> Int(nuevoX)) Or (Int(cosa.PositionY) <> Int(nuevoY)) Then
            cosa.SetPosition nuevoX, nuevoY
        End If
        If angulo < 0 Then angulo = (angulo Mod 360) + 360
        If angulo > 360 Then angulo = angulo Mod 360
 
        'You can't rotate something to the same angle.
 
        If angulo <> 0 Then
            ang = angulo / 10
            'Layer.Rotate angle is specified in
            'tens of degrees (ang=1 means 10 degrees)
            cosa.Rotate ang, _
                cosa.PositionX, _
                (ActiveDocument.SizeHeight - cosa.PositionY)
                'RotationY is counted from bottom to top
                'but positionY is counted from top to bottom.
        End If
        DoEvents
     '   cosa.SetPosition nuevoX, nuevoY
        angulo = angulo + anguloDelta
        'this tests if we've reached the end.
        'SGN is used to be aware of angulodelta sign.
        If Sgn(anguloMax - angulo) <> Sgn(anguloDelta) Then
            angulo = anguloMin
            nuevoX = nuevoX + anchoX
            If nuevoX >= ActiveDocument.SizeWidth Then
                nuevoX = anchoX / 2
                nuevoY = nuevoY + altoY
                If nuevoY > ActiveDocument.SizeHeight Then
                    nuevoY = altoY / 2
                    Visibility = False
                End If
            End If
        End If
        If Visibility = False Then
            cosa.Visible = False
        Else
            cosa.Visible = True
        End If
    Next
End Sub
 
 
'Unarranges a bunch of photos placed in different object layers.
'    You'd probably had to move some photos from bottom-right to top-left.
'Desordena un grupo de fotos colocadas en distintas capas de objeto.
'    Probablemente tendrá que mover después algunas fotos
'    de la zona inferior derecha a la superior izquierda.
Sub DesordenaObjetos()
    'cosa= object layer.
    Dim cosa As Layer
 
    'origen=source. Destino=destination.
    Dim origen As Integer, destino As Integer
 
    For Each cosa In ActiveDocument.Layers
 
        cosa.Rotate Int(Rnd * 360), Int(Rnd * ActiveDocument.SizeWidth), Int(Rnd * ActiveDocument.SizeHeight)
        cosa.SetPosition Int(Rnd * ActiveDocument.SizeWidth), Int(Rnd * ActiveDocument.SizeHeight)
 
 
    Next
 
    '
    'Try to rearrange layers. This is not the best approach, since
    'when we change z-order we also change layer index.
    '
    'A matrix should be used for true randomization instead.
    '
    For origen = ActiveDocument.Layers.Count To 1 Step -1
        destino = Int(Rnd(ActiveDocument.Layers.Count - 1) + 1)
        If origen <> destino Then
            ActiveDocument.Layers(origen).OrderFrontOf ActiveDocument.Layers(destino)
        End If
    Next
 
End Sub
 
Sub prueba()
    Dim cosa As Layer
    Dim anchoX As Long, altoY As Long
    Dim nuevoX As Long, nuevoY As Long
 
    With ActiveDocument.Layers(1)
        Debug.Print .PositionX, .PositionY
        ActiveDocument.Layers("Objeto 2").LayerGroup.GetPosition nuevoX, nuevoY
        .Rotate 0, 0, 0 '.PositionX, .PositionY
Debug.Print .PositionX, .PositionY
 
    End With
End Sub
 
'Hide all objects (for debug purposes)
'Oculta todo (para depurar)
Sub hideallobjects()
    Dim cosa As Layer
    For Each cosa In ActiveDocument.Layers
        cosa.Visible = False
    Next
 
End Sub