Re: Сделать подобный скрипт

Написал wOxxOm в 09/07/2010 9:28:22

когда-то очень давно писал на форуме там же, скорее всего будет работать и в Х4/Х5

Sub scatter()
   Dim sh As Shape, sr As ShapeRange, x#, y#, w#, h#, i&
   Dim AgentSmith As Shape, VSR As ShapeRange
   
   If ActiveDocument Is Nothing Then Exit Sub
   Set sr = ActiveSelection.Shapes.FindShapes()
   If sr.Count = 0 Then
      MsgBox "Select target objects, invoke the macro, click Agent Smith shape"
      Exit Sub
   End If
   If ActiveDocument.GetUserClick(x, y, i, -1, Snap:=false, CursorShape:=313) Then _
      Exit Sub
   
   With ActivePage.SelectShapesAtPoint(x, y, SelectUnfilled:=True)
      If .Shapes.Count = 0 Then Beep: Exit Sub
      Set AgentSmith = .Shapes(.Shapes.Count)
   End With

   Set VSR = New ShapeRange
   ActiveDocument.ReferencePoint = cdrCenter
   For Each sh In sr
      sh.GetBoundingBox x, y, w, h
      With AgentSmith.TreeNode.GetCopy
         .VirtualShape.RotationAngle = sh.RotationAngle
         .VirtualShape.SetBoundingBox x, y, w, h, KeepAspect:=True
         .LinkAsChildOf sh.Layer.TreeNode
         VSR.Add .VirtualShape
      End With
   Next
   
   ActiveDocument.LogCreateShapeRange VSR
   sr.delete ' evaporate originally selected shapes
End Sub

Работает так: выделяем кучу объектов, запускаем макрос, тыкаем в заменитель.
Имхо так быстрее, чем через тормозной буфер корела.