Заполнение фигуры рисунком

[ab-surd]

Доброго времени суток.
По данной теме уже поднимался вопрос, но к сожаления ответа на него там нет. По этому хотелось бы узнать есть ли решение ниже следующей задачи.
Есть некая фигура, например окружность (рис.1)
необходимо эту окружность заполнить, такими же окружностями, но меньшего размера.
После некоторых манипуляций получаем результат рис.2 из него видно перекрытие малых окружностей. Хотелось бы автоматизировать это все таким образом что бы получалось как на рис.3 Не мало важное требование, что размер кружков и расстояния между ними должны контролироваться пользователем, и что бы их размещение было равномерным без каких либо перекрытий.
Подскажите пожалуйста, оооочень надо) Если готовых решений нет, то можно подумать над разработкой за $

 

[_MBK_]

Ответ: Заполнение фигуры рисунком

Вообще-то вопрос не в автоматизацию.
Рисуете маленький кружочек, перемещаете его центр в центр большого круга, высчитываете количество градусов между шагами, используя это значение, дублируете кружок по окружности. Сдвигаете кружок чуть ближе к центру (можно эту операцию проделать сразу, скажем, через бленд) и повторяете уже с ним - и так по очереди, пока круг не заполнится. Дело пяти минут, причем большая часть из них на расчеты углов поворота.

 

[ab-surd]

Ответ: Заполнение фигуры рисунком

С простыми фигурами вариант ручной отрисовки проходит, а вот если фигура сложная и их несколько, то тут уже проблема.
Раскидать 1500 кружочков руками довольно сложно, да и попытаться не просто раскидать, а сделать это ровно, что бы промежутки между ними были одинаковые.

 

[carrot]

Ответ: Заполнение фигуры рисунком

http://corelvba.com/ru/index.php?pages=led_1 и еще на macromonster.com какой-то макрос на эту тему есть, сейчас лень искать

 

[M.O.Z.G]

Ответ: Заполнение фигуры рисунком

Долгое время считал такие эффекты большим, сложным, кропотливым процессом, пока однажды не открыл для себя совершенно шикарный плагин для Illustrator'а - Phantasm. Помимо прочих своих очень полезных качеств в работе с предпечаткой и цветоделением, он имеет фильтр Halftone, с довольно гибкими настройками. Так вот он поможет Вам забить форму хоть шариками, хоть буковками, хоть любым другим символом из библиотеки в соответствии с заданными размерами и алгоритмами направления. Можно использовать полутоновое изображение для специфического варьирования размеров отдельных элементов, если такая необходимость есть.

Вот здесь есть видео демонстрирующее работу этого фильтра, правда на примере получения многцветного изображения, но суть понятна. Он одинокого хорошо работает и с одноцветными объектами.

 

[ab-surd]

Ответ: Заполнение фигуры рисунком

Большое спасибо друзья! Попробую варианта, и отпишусь о результате.

 

[ekali]

Ответ: Заполнение фигуры рисунком

Я знаю два способа: матричное заполнение и концентрическое. При обоих создаются линии в границах объекта, которые потом преобразуются в цепочки маленьких объектов (кружочков или чего-то еще, неважно).

Коды такие:

Sub MATRIXizPOLOSOK() ' - MATRIX 2, dublirovanie fonovykh polosok => obrezka pod ishodnuyu figuru => cut ishodnuyu figuru => obrabotka obrezannyh polosok spreem
    ' Recorded 03.01.2012
    Dim s1 As Shape, s2 As Shape, inters As Shape, ishodn As Shape
    Dim i As Long, iE As Long, iC As Long
    Dim Leftt As Double, Topp As Double, Rightt As Double, Bottomm As Double, Vysota As Double
    Dim x As Double, y As Double, diam As Double
    
    
    ActiveDocument.Unit = cdrMillimeter
    
    Dim dup1 As ShapeRange
    diam = 1.5
    x = ActiveLayer.Shapes(1).SizeWidth
    y = ActiveLayer.Shapes(1).SizeHeight
    If y < x Then x = y
    x = (x - diam * 2) / x ' takim obrazom zadaetsya otstup, ravnyi dvum diametram budushih kruzhkov (oni zadayutsya v makrose "shtrihiVcircles")
    x = x * 0.95
    Set dup1 = ActiveLayer.Shapes(1).DuplicateAsRange
    
    ActiveDocument.ReferencePoint = cdrCenter
    dup1.Stretch x
    ActiveDocument.ReferencePoint = cdrTopLeft


    Set ishodn = ActiveLayer.Shapes(1)
    
    Vysota = diam * 3
    
    iE = ActiveLayer.Shapes.Count
    For i = 2 To iE
        'ActiveLayer.Shapes(i).Delete
    Next i
    ishodn.GetPosition x, y
    Leftt = x
    Topp = y - Vysota
    Rightt = x + ishodn.SizeWidth
    'Bottomm = y - Vysota * 2
    Set s1 = ActiveLayer.CreateLineSegment(Leftt, Topp, Rightt, Topp) 


    iC = ishodn.SizeHeight / Vysota '(Vysota * 2)
    '--------------------
    For i = 1 To iC
        Set s2 = s1.Duplicate
        s2.Move 0#, -Vysota * i '* 2 * i
        Set inters = ishodn.Intersect(s2, True, True)
        s2.Delete
    Next i
    Set inters = ishodn.Intersect(s1, True, True)
    s1.Delete
    ishodn.Delete
End Sub

Sub duplicate_contour() ' duplicate the conturs (from the boundaries to the centre) - chtoby potom pomenyat' kontury na circles
    Dim i As Long, iNodes As Long, iSegments As Long, isubPa As Long, iE As Long
    Dim s As Shape, s1 As Shape, brk1 As ShapeRange
    Dim Stri As String
    Dim contur As Effect ' As Shape
    Dim Stepp As Double


    ActiveDocument.Unit = cdrMillimeter
    Set s = ActiveLayer.Shapes(1)
    ActiveDocument.ReferencePoint = cdrCenter


    Stepp = 0.3
    For i = 1 To 9


        Set contur = s.CreateContour(cdrContourInside, i * Stepp, 1, cdrDirectFountainFillBlend, CreateCMYKColor(0, 0, 0, 100), CreateCMYKColor(0, 0, 0, 100), CreateCMYKColor(0, 0, 0, 100), 0, 0, cdrContourSquareCap, cdrContourCornerMiteredOffsetBevel, 15#)
        contur.Contour.ContourGroup.Separate


    Next i
    
  
End Sub

Потом есть пять способов, как поменять эти полоски на кружочки. Я сейчас пишу про последний, когда мы всем объектам прописали абрисы-штрихи, потом преобразовали абрисы в кривые, разъединили кривые (вообще-то тоже макросом, почему-то вручную он сцепления не видит), ну и остались с большим-большим количеством маленьких объектов любого вида (штришков, например).

Дальше вот что:

[LEFT][COLOR=#3D3726]iE = ActiveLayer.Shapes.Count[/COLOR]
[COLOR=#3D3726]For i = iE To 1 Step -1 'zapominaem raspolozhenie ob'ektov[/COLOR]
[COLOR=#3D3726]    ActiveLayer.Shapes(i).GetPosition x, y[/COLOR]
[COLOR=#3D3726]    xs(i) = x[/COLOR]
[COLOR=#3D3726]    ys(i) = y[/COLOR]
[COLOR=#3D3726]Next i[/COLOR]
[COLOR=#3D3726]ActivePage.Shapes.All.Delete[/COLOR]
[COLOR=#3D3726]diam = 1.5[/COLOR]
[COLOR=#3D3726]For i = 1 To iE [/COLOR]
[COLOR=#3D3726]   If Len(xs(i)) > 0 Then[/COLOR]
[COLOR=#3D3726]       Set s = ActiveLayer.CreateEllipse2(xs(i), ys(i), diam)[/COLOR]
[COLOR=#3D3726]   End If[/COLOR]
[COLOR=#3D3726]Next i[/COLOR][/LEFT]