OberonPlace.com Forums  

Go Back   OberonPlace.com Forums > Developer Forums > VBA > CorelDRAW/Corel DESIGNER VBA

Reply
 
Thread Tools Search this Thread Display Modes
  #1  
Old 04-07-2018, 10:30
aakkaarr aakkaarr is offline
Senior Member
 
Join Date: Jan 2009
Posts: 154
Default 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
Attached Images
 
Reply With Quote
  #2  
Old 05-07-2018, 03:20
shark shark is offline
Senior Member
 
Join Date: Aug 2010
Location: Russia, Belgorod
Posts: 145
Default

It's not difficult to fill rectangle with circles. It's harder to check that the circles do not intersect
Reply With Quote
  #3  
Old 05-07-2018, 05:20
aakkaarr aakkaarr is offline
Senior Member
 
Join Date: Jan 2009
Posts: 154
Default

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
Reply With Quote
  #4  
Old 06-07-2018, 01:40
shark shark is offline
Senior Member
 
Join Date: Aug 2010
Location: Russia, Belgorod
Posts: 145
Default

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
Reply With Quote
  #5  
Old 06-07-2018, 01:46
shark shark is offline
Senior Member
 
Join Date: Aug 2010
Location: Russia, Belgorod
Posts: 145
Default

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
Reply With Quote
  #6  
Old 06-07-2018, 10:42
aakkaarr aakkaarr is offline
Senior Member
 
Join Date: Jan 2009
Posts: 154
Default

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
Reply With Quote
  #7  
Old 06-07-2018, 10:50
aakkaarr aakkaarr is offline
Senior Member
 
Join Date: Jan 2009
Posts: 154
Default

Like this Image
Attached Images
 
Reply With Quote
  #8  
Old 09-07-2018, 06:08
shark shark is offline
Senior Member
 
Join Date: Aug 2010
Location: Russia, Belgorod
Posts: 145
Default

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
Reply With Quote
  #9  
Old 09-07-2018, 15:28
aakkaarr aakkaarr is offline
Senior Member
 
Join Date: Jan 2009
Posts: 154
Default

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
Attached Images
 

Last edited by aakkaarr; 09-07-2018 at 15:36.
Reply With Quote
  #10  
Old 10-07-2018, 03:14
shark shark is offline
Senior Member
 
Join Date: Aug 2010
Location: Russia, Belgorod
Posts: 145
Default

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
Reply With Quote
Reply


Currently Active Users Viewing This Thread: 1 (0 members and 1 guests)
 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off

Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
rectangle around (rotation) buga Macros/Add-ons 5 06-11-2011 07:20
Rectangle bug? runflacruiser CorelDRAW/Corel DESIGNER VBA 2 21-07-2011 06:55
Fill a shape with Circles biok CorelDRAW/Corel DESIGNER VBA 13 05-03-2011 12:00
4mm rectangle around the object fungel CorelDRAW/Corel DESIGNER VBA 11 06-03-2009 15:47
Circles to Circles Hernán New product ideas 3 15-03-2004 08:41


All times are GMT -5. The time now is 02:21.


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