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
NEW. GDG Macros Suite 2023.
Please note: Macros 2023 (and above if their will be any) 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

Code:
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
        newCircle.AddToSelection
        lilCircle.AddToSelection
    Next i

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

'group all the shapes we created and set them assign to a shape
    ActiveSelection.Group
    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
    circlesSR.CreateSelection
  
    Set tempSr1 = ActiveSelection.UngroupAllEx
    tempSr1.CreateSelection

'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
            sTemp.Delete
        Else
            sTemp.AddToSelection
        End If
        
    Next sTemp
'remove the rest that lay outside of container
    Set finalCircleS2 = ActiveSelection.Shapes.All.Combine
    finalCircleS2.Intersect ContainerSr(1), False, True
    
    ActiveDocument.EndCommandGroup
    
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.



gdg






corel macros boost workflow
*Searches the FREE and Commercial Macros


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

find it on yahoo

FIND IT ON

find it on google