Autocad VBA Color Wheel Program Part 1

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.

screenshot_4-17-2016_1

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
Advertisements

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s