GDG Code Chunks, Discussion, VBA Snippets for CorelDRAW, Simple Macro Helpers!

cool vba macros for corel show cart gdg corel draw macros checkoutMyAccount corel macros
VBA Corel Macro Help
john's macros
thanks for stopping by gdg macros

Helpful VBA Code
GDG Macro Suite 2024 is available. Those who have purchased the 2023 Suite, contact me if you need to upgrade to GDG Macros Suite 2024.

55% off upgrade discount code has been emailed to all those who bought suite 2023. New in this suite, several "B" versions of macros, for those having issues with macros running in systems with international decimal settings.

Previous message (5-15-2024): Hi, all. Sorry for any lack of communication lately. I have been extremely busy running my graphics and car audio shop. The days are long with little rest. I finally had a chance to see some of your emails and will see what I can do about CorelDraw 2024 macros. I haven't decided on an exact direction but may release mini-suites, or just the whole suite again with upgrade pricing. The best deal of course would be the purchase of the GDG Macro Suite.
Available now! GDG Macros Suite 2023.
Please note: Macros 2023 and above will no longer be sold separately.
Join me on Facebook to stay up to date with news, updates. Subscribe to my YouTube Channel for tutorial videos and tips. Need a custom macro? Contact me.
Not all macros are guaranteed to be continued due to compatibility reasons or other. Read new-version policy here.
I appreciate everyone! Upgrading macros and maintaining this site is quite a task for me. Want to contribute? Please DONATE
^ Hide these messages to save screen space ^

<<Back to helpful code list

My quick attemp at filling a shape with circles or stars.

Decription: No Description Left for this code

Date: 2010-05-04 Author: John

Option Explicit

Sub fillWithCircles()

    Dim container As Shape, circles As Shape
    Dim lilCircle As Shape, lilCircle2 As Shape, rowShAdd As Shape, tempSh1 As Shape
    Dim x#, y#, h#, w#, w1#, h1#
    Dim x1#, y1#
    Dim dia#, space#, marg#
    Dim amountStacked As Long
    Dim amountRows As Long, totalCircles As Long
    Dim i As Integer
    Dim circlesSR As New ShapeRange
    Dim ContainerSr As New ShapeRange
    Dim finalCirclesSr2 As New ShapeRange
    Dim newCircle As Shape, newCircle2 As Shape
    Dim finalCircleS As Shape, sTemp As Shape, finalCircleS2 As Shape, rowSh As Shape
    Dim crspt As CrossPoints
    Dim tempSr1 As ShapeRange, finalCirclesSr As ShapeRange
    Dim a#, b#, c#

    ActiveDocument.BeginCommandGroup "fill with circles"
    dia = 0.2 'set your circle (or any shape) diameter here
    space = 0.1 'spacing between circles
    marg = 0.01 ' just a starting point
'get the active selection and add it to a shaperange and get it's bounding box
    Set container = ActiveSelection
    container.ConvertToCurves 'convert it to curves so we can detect crosspoints later.
    ContainerSr.Add container
    ContainerSr(1).GetBoundingBox x, y, w, h
'create the first and 2nd shape (staggered shapes)
'add it to it's own shaperange for circles
'create whatever shape you want here -- or 2 different shapes!!!

    a = (dia / 2) + (space / 2)
    c = dia + space
    b = Sqr(c ^ 2 - a ^ 2) ' side we need to calculate

'fill with circles
    'Set lilCircle = ActiveLayer.CreateEllipse2(x + (dia / 2) + marg, y + (dia / 2) + marg, dia / 2)
    'Set lilCircle2 = lilCircle.Duplicate(b, a)
'fill with stars
    Set lilCircle = ActiveLayer.CreatePolygon2(x + (dia / 2) + marg, y + (dia / 2) + marg, dia / 2, 5, , , True)
    Set lilCircle2 = ActiveLayer.CreatePolygon2(x + (dia / 2) + marg + b, y + (marg / 2), dia / 2, 5, , , True)
    Set lilCircle = lilCircle.Weld(lilCircle, False, False)
    Set lilCircle2 = lilCircle2.Weld(lilCircle2, False, False)
'how many fit in height
    amountStacked = (h - (marg * 2)) / (dia + space)
'create first row vertically
    For i = 1 To (amountStacked - 1)
        Set newCircle = lilCircle.Duplicate
        lilCircle.Move 0, dia + space
    Next i

'create 2nd (staggered) row
    For i = 1 To (amountStacked)
        Set newCircle2 = lilCircle2.Duplicate
        lilCircle2.Move 0, dia + space
    Next i

'group all the shapes we created and set them assign to a shape
    Set circles = ActiveSelection
    circles.AlignToShape cdrAlignVCenter, ContainerSr(1)
    circles.GetSize w1, h1
    amountRows = ((w - (marg * 2)) / (w1 + b)) + 1
    Set rowSh = circles.Combine
'now create rows across horizontally...
    For i = 1 To amountRows + 2
        Set rowShAdd = rowSh.Duplicate
        rowSh.Move b * 2, 0
        circlesSR.Add rowShAdd
    Next i
    circlesSR.Add rowSh
    Set tempSr1 = ActiveSelection.UngroupAllEx

'align the group of shapes to center of container horizontally
    Set tempSh1 = ActiveSelection.Combine
    tempSh1.AlignToShape cdrAlignHCenter, ContainerSr(1)

    Set finalCircleS = ActiveSelection.Shapes.All.Combine
    Set finalCirclesSr = finalCircleS.BreakApartEx
'find intersecting shapes and delete
    For Each sTemp In finalCirclesSr
        Set crspt = sTemp.Curve.SubPaths(1).GetIntersections(ContainerSr(1).Curve.SubPaths(1))
        If crspt.count > 0 Then
        End If
    Next sTemp
'remove the rest that lay outside of container
    Set finalCircleS2 = ActiveSelection.Shapes.All.Combine
    finalCircleS2.Intersect ContainerSr(1), False, True
End Sub

Title: double click to make a circle inside a square
Comment left by: Myron
Date: 2013-07-25
Comment left:
I know you can select any object and while holding shift double-click the rectangle tool to make a square around the object. How about double-click circle tool to put a single circle inside a square? Or a macro to do it. I tried to revise a "MakeMeABox" macro to make an elipse but it wouldn't work.


corel macros boost workflow
*Searches the FREE and Commercial Macros

CorelDraw macros for version 2024

CorelDraw macros for version 2023

CorelDraw macros for version 2020

CorelDraw macros for version 2019

CorelDraw macros for version 2018

CorelDraw macros for version 2017

macros for coreldraw x8

macros for coreldraw x7

macros for corel draw x6

macros for corel draw x6


find it on yahoo


find it on google