

Thread Tools  Search this Thread  Display Modes 
#1




To fill a rectangle with circles randomly with VBA code
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 
#2




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

#3




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 
#4




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 
#5




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

#6




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 
#7




Like this Image

#8




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 
#9




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 Last edited by aakkaarr; 09072018 at 16:36. 
#10




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 
Currently Active Users Viewing This Thread: 1 (0 members and 1 guests)  
Thread Tools  Search this Thread 
Display Modes  


Similar Threads  
Thread  Thread Starter  Forum  Replies  Last Post 
rectangle around (rotation)  buga  Macros/Addons  5  06112011 08:20 
Rectangle bug?  runflacruiser  CorelDRAW/Corel DESIGNER VBA  2  21072011 07:55 
Fill a shape with Circles  biok  CorelDRAW/Corel DESIGNER VBA  13  05032011 13:00 
4mm rectangle around the object  fungel  CorelDRAW/Corel DESIGNER VBA  11  06032009 16:47 
Circles to Circles  Hernán  New product ideas  3  15032004 09:41 