How many rectangles fit into each shape in the drawing?

Hello,

You want to improve your VBA code for fitting rectangles into various shapes in CorelDRAW. Your current code handles only one shape and doesn't rotate the rectangles or fit them into multiple shapes. Here's how you can modify and expand your code to address these issues:

Support Multiple Shapes: Iterate over all shapes in the ShapeRange.
Rectangle Rotation: Consider rotations when placing rectangles.
Check Fit: Ensure the rectangles fit inside the shapes considering the rotation.

Revised code:

Here’s a revised version of your VBA code that addresses these needs: 

Private Sub CommandButton18_Click()
Dim sr As ShapeRange
Dim boundaryShape As Shape
Dim rectWidth As Double
Dim rectHeight As Double
Dim rect As Shape
Dim rectCount As Integer
Dim i As Integer, j As Integer
Dim xOffset As Double, yOffset As Double
Dim stepAngle As Double
Dim minX As Double, minY As Double, maxX As Double, maxY As Double
Dim fitCount As Integer

' Set the unit to cm
ActiveDocument.Unit = cdrCentimeter
Set sr = ActiveSelectionRange

' Rectangle dimensions
rectWidth = 13
rectHeight = 10

' Rotation angles (0 to 360 degrees in 15-degree steps)
For stepAngle = 0 To 345 Step 15
fitCount = 0

' Loop through each shape in the selected range
For Each boundaryShape In sr.Shapes
If boundaryShape.Type = cdrCurveShape Then
' For each rotation, try to fit rectangles
For i = 0 To Int(boundaryShape.SizeWidth / rectWidth) - 1
For j = 0 To Int(boundaryShape.SizeHeight / rectHeight) - 1
xOffset = boundaryShape.LeftX + i * rectWidth
yOffset = boundaryShape.BottomY + j * rectHeight

' Create and rotate the rectangle
Set rect = ActiveLayer.CreateRectangle2(xOffset, yOffset, rectWidth, rectHeight)
rect.Rotate stepAngle

' Get bounding box coordinates
rect.GetBoundingBox minX, minY, maxX, maxY

' Check if rectangle is within boundaryShape
If IsRectangleInside(minX, minY, maxX, maxY, boundaryShape) Then
fitCount = fitCount + 1
End If

' Delete the rectangle
rect.Delete
Next j
Next i
End If
Next boundaryShape

' Display the result for this rotation
MsgBox "With rotation " & stepAngle & " degrees, " & fitCount & " rectangles fit into the selected shapes."
Next stepAngle
End Sub

Function IsRectangleInside(minX As Double, minY As Double, maxX As Double, maxY As Double, boundaryShape As Shape) As Boolean
' This function checks if the rectangle's bounding box is within the boundary shape
Dim inside As Boolean
inside = True

If minX < boundaryShape.LeftX Or maxX > boundaryShape.RightX Or _
minY < boundaryShape.BottomY Or maxY > boundaryShape.TopY Then
inside = False
End If

IsRectangleInside = inside
End Function

Tips: Multiple Shapes: The code loops through all shapes in the selected range.
Rectangle Rotation: It tests rectangle placement for every 15-degree rotation.
Fit Check: The IsRectangleInside function checks Maxim Time Clock if the rotated rectangle fits within the boundary shape.

Hope that helps!