The program from bottom up.
Public Const Pi As Double = 3.14159265359 Function deg2rad(deg As Double) As Double deg2rad = deg * Pi / 180 End Function
Our pie slice sub-routine is actually a pie section, with an inner and outer radius, and start and end angle. We will input the angles in degrees and convert them to radians in the sub-routine. The origin point 0,0 will be used for the center of the wheel.
The draw_arc subroutine takes input Radius, start and end angle in degrees for the Addarc method.
Sub draw_arc(Radius As Double, startAngleInDegree As Double, endAngleInDegree As Double) 'from point 0,0 Dim arcObj As AcadArc Dim a1_rad As Double, a2_rad As Double Dim pt0(0 To 2) As Double pt0(0) = 0: pt0(1) = 0: pt0(2) = 0 a1_rad = deg2rad(startAngleInDegree) a2_rad = deg2rad(endAngleInDegree) 'addarc - center, radius, startangle, endangle Set arcObj = acadDoc.ModelSpace.AddArc(pt0, Radius, a1_rad, a2_rad) End Sub
The draw_polar_line subroutine is a straightforward line command using polar coordinates. Instead of point form (x,y) they are input as (r,a) (radius, angle) and converted to x and y.
Sub draw_polar_line(r1 As Double, a1 As Double, r2 As Double, a2 As Double) 'draw line given polar coordinates 'angles are given in degrees Dim lineobj As AcadLine Dim pt1(0 To 2) As Double Dim pt2(0 To 2) As Double Dim x1 As Double, y1 As Double Dim x2 As Double, y2 As Double Dim a1_rad As Double, a2_rad As Double a1_rad = deg2rad(a1) a2_rad = deg2rad(a2) x1 = r1 * Cos(a1_rad) y1 = r1 * Sin(a1_rad) x2 = r2 * Cos(a2_rad) y2 = r2 * Sin(a2_rad) pt1(0) = x1: pt1(1) = y1: pt1(2) = 0 pt2(0) = x2: pt2(1) = y2: pt2(2) = 0 Set lineobj = acadDoc.ModelSpace.AddLine(pt1, pt2) End Sub
a test subroutine draws an arced wedge with canned input.
Sub testslice1() Call connect_acad 'r1=6, r2=9 'a1=30 a2=45 Call draw_arc(6, 30, 45) Call draw_arc(9, 30, 45) Call draw_polar_line(6, 30, 9, 30) Call draw_polar_line(6, 45, 9, 45) End Sub
To convert these lines and arcs into a region object that we can fill with a solid color, we have to satisfy the AddRegion method’s specific requirements. AddRegion requires an array of AcadEntities. You must create the objects, add them to the array, then hand the array to the Addregion method, which returns an array of Region objects, which must be declared as a variant.
We know we are only intending to have 4 objects in the AcadEntity array, so we dimension that 0 to 3 for this single purpose. To add the objects to an array, I have added them as they are created to a selection set. It requires a generic selection set subroutine for creating a new empty set. The items in the selection set are added to the array with a loop.
Here is the augmented testslice2. we will start to work with variable input for the dimensions of the slice. The selection set subroutine is at the end.
Sub testslice2() Call connect_acad Dim r1 As Double, r2 As Double Dim a1 As Double, a2 As Double Dim i As Integer Dim entarray(0 To 3) As AcadEntity Dim regionObj As Variant r1 = 6 r2 = 9 a1 = 30 a2 = 45 Dim sset4 As AcadSelectionSet Call add_ss("temp4") Set sset4 = acadDoc.SelectionSets.Item("temp4") Call draw_arc(r1, a1, a2) sset4.Select acSelectionSetLast Call draw_arc(r2, a1, a2) sset4.Select acSelectionSetLast Call draw_polar_line(r1, a1, r2, a1) sset4.Select acSelectionSetLast Call draw_polar_line(r1, a2, r2, a2) sset4.Select acSelectionSetLast For i = 0 To sset4.Count - 1 Set entarray(i) = sset4(i) Next i regionObj = acadDoc.ModelSpace.AddRegion(entarray) sset4.Erase 'erases the line and arc entities in the drawing sset4.Delete 'deletes the selection set in the drawing End Sub Sub add_ss(strname As String) 'adds a new empty named selection set Dim s_set As AcadSelectionSet On Error Resume Next Set s_set = acadDoc.SelectionSets.Item(strname) s_set.Clear s_set.Delete On Error GoTo 0 Set s_set = acadDoc.SelectionSets.Add(strname) End Sub
Now we just have to color the region object. Unfortunately, it is transparent in normal (2D wireframe) viewing mode, but it is easy to hatch it a solid color. Coloring the region object itself requires getting the objects from the array that was returned when the region was created. We only expect one region was created, so that is always accessible with regionobj(0).
Here is the finished makeslice. We finalize the parameter input, add the RGB values, and we are ready for the loop that calls this thing.
Sub testslice3() Call connect_acad Call makeslice(6, 9, 30, 45, 220, 160, 230) End Sub Sub makeslice(r1 As Double, r2 As Double, a1 As Double, a2 As Double, i_r As Integer, i_g As Integer, i_b As Integer) Dim i As Integer Dim entarray(0 To 3) As AcadEntity Dim regionObj As Variant Dim objhatch As AcadHatch Dim sset4 As AcadSelectionSet Call add_ss("temp4") Set sset4 = acadDoc.SelectionSets.Item("temp4") Call draw_arc(r1, a1, a2) sset4.Select acSelectionSetLast Call draw_arc(r2, a1, a2) sset4.Select acSelectionSetLast Call draw_polar_line(r1, a1, r2, a1) sset4.Select acSelectionSetLast Call draw_polar_line(r1, a2, r2, a2) sset4.Select acSelectionSetLast For i = 0 To sset4.Count - 1 Set entarray(i) = sset4(i) Next i regionObj = acadDoc.ModelSpace.AddRegion(entarray) sset4.Erase 'erases the line and arc entities in the drawing sset4.Delete 'deletes the selection set in the drawing Set objhatch = acadDoc.ModelSpace.AddHatch(1, "Solid", True) objhatch.AppendOuterLoop regionObj Dim color As AcadAcCmColor Set color = AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor.20") Call color.SetRGB(i_r, i_g, i_b) objhatch.TrueColor = color regionObj(0).TrueColor = color End Sub