OberonPlace.com Forums

OberonPlace.com Forums (http://forum.oberonplace.com/index.php)
-   CorelDRAW/Corel DESIGNER VBA (http://forum.oberonplace.com/forumdisplay.php?f=16)
-   -   To fill a rectangle with circles randomly with VBA code (http://forum.oberonplace.com/showthread.php?t=24814)

aakkaarr 04-07-2018 11:30

To fill a rectangle with circles randomly with VBA code
 
1 Attachment(s)
code to fill a rectangle with circles with random sizing and spacing
Please see the attached jpg to clearly follow my point
In the image I have placed red circles of various size and placed it randomly without overlapping
I have done it manually. Can it be done by vba code by just one red circle

shark 05-07-2018 04:20

It's not difficult to fill rectangle with circles. It's harder to check that the circles do not intersect

aakkaarr 05-07-2018 06:20

I am having the same problem of checking circles for intersection
Can you help me code circles to fill rectangle with various size, I think the intersecting problem can be manually corrected

shark 06-07-2018 02:40

Code:

Sub FillRandomCircles()
Const MaxSize = 15 'max radius of ellipse, i.e. MinSize + MaxSize
Const MinSize = 5  'min radius
Dim s As Shape, x#, y#, w#, h#, z&
    ActiveDocument.Unit = cdrMillimeter
    ActivePage.GetBoundingBox x, y, w, h
    Randomize
    For z = 1 To 100
        Set s = ActiveLayer.CreateEllipse2(x + Rnd * w, y + Rnd * h, Rnd * MaxSize + MinSize)
    Next
End Sub


shark 06-07-2018 02:46

in theory, you can add each created ellipse to the group and check the intersection with this shape-group, using Shape.Intersect. If the function returns an object, then delete the ellipse and create a new one

aakkaarr 06-07-2018 11:42

Thanks Shark
Now if I have a Star shape or any custom shape and i want to fill rectangle with this shape with random sizes
Help me do this

aakkaarr 06-07-2018 11:50

1 Attachment(s)
Like this Image

shark 09-07-2018 07:08

You may change
Set s = ActiveLayer.CreateEllipse2(x + Rnd * w, y + Rnd * h, Rnd * MaxSize + MinSize)
to
Set s = ActiveLayer.CreatePolygon2(x + Rnd * w, y + Rnd * h, Rnd * MaxSize + MinSize, NSide, , , true)
where NSide = number of sides (5 for star)
or use function CreatePolygon

aakkaarr 09-07-2018 16:28

1 Attachment(s)
Thanks Shark,
But if it is not a polygon that fills the rectangle, it is some bitmap or a random shape.
It is to be filled with a sample shape as in the image
May be moving and resizing duplicates of sample shape to random location in the rectangle
What is your theory about this

shark 10-07-2018 04:14

Code:

Sub FillRandShapes()
Const MaxSize = 15
Const MinSize = 5
Dim s As Shape, X#, Y#, w#, h#, z&
    ActiveDocument.Unit = cdrMillimeter
    ActivePage.GetBoundingBox X, Y, w, h
    Randomize
    Set s = ActiveShape: If s Is Nothing Then Exit Sub
   
    For z = 1 To 100
        Set s = s.Duplicate
        s.SetPosition X + Rnd * w, Y + Rnd * h
        s.SetSize Rnd * MaxSize + MinSize
    Next
End Sub

this code duplicates any selected shape and scatter it inside page


All times are GMT -5. The time now is 01:50.

Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.
Copyright © 2011, Oberonplace.com