Autocad Help System for Lisp and VBA (ActiveX)

I have found the front end pages for Autocad programming languages VBA (ActiveX) and Lisp (Visual Lisp). Here is my big suggestion. You can copy and paste an entire page of links into Excel and the links transfer. Use Excel to collate and organize Autodesk help bookmarks.

Autodesk splits both subjects into two groups – what they call a Guide which would be teaching text and a Reference which is a page by page Index. Visual Lisp is traditional Autocad Lisp plus ActiveX. So if you are looking for Visual Lisp help, you need to include the ActiveX references in your reading list.

As of 2017, Autodesk has returned “Developer Documentation” to its front end for Autocad 2017 help,
http://help.autodesk.com/view/ACD/2017/ENU/

Following that link brings you to this page to be bookmarked,
http://help.autodesk.com/view/ACD/2017/ENU/?home=homepage_dev

If you copy and paste that page into excel, the links all transfer without any additional work. Here i have marked with asterisk the 5 critical pages.
2017-02-22_2

you can then make tabs for guide and reference for both lisp and activeX. In a few minutes you have an upper level table of contents in a single file. as you explore the pages using the live links you can make notes or mark as read. you can make a reference to the entire page at the top of your excel sheet. Pages come in formatted with good links, you might have to reset column width and row height for entire sheet.

2017-02-22_3

If you are looking for Visual Lisp code, it is in the ActiveX reference. Both groups ActiveX and Lisp have an Object Model page, but the Lisp page is not live, just a picture. The Object Model page for ActiveX has live links. You do not need to paste that page into Excel, but it also pastes with live links, and you never have to go looking for it. You can have the Object Model with links in your spread sheet. Regardless how you access it, it is a very valuable tool.

As an example of its usefulness, say you want to know how to draw a circle with Visual Lisp.

2017-02-22_4

Click on the Circle object. It takes you to Circle Object ActiveX help page. Which has the properties and methods of the object that is a circle, but it does not have the tool to draw a circle. The Addcircle is a method of ModelSpace, PaperSpace and Block. Click on ModelSpace, scroll down to the methods, and click on AddCircle. there you find the code to draw a circle in both VBA and Lisp. Code that you can paste into your VBA module or Lisp editor.

http://help.autodesk.com/view/ACD/2017/ENU/?guid=GUID-18ADF171-166F-4FF0-8ED6-5F83153A5649#GUID-18ADF171-166F-4FF0-8ED6-5F83153A5649

http://help.autodesk.com/view/ACD/2017/ENU/?guid=GUID-837C702F-91A7-445B-8713-3099B94664BE

the object model –

http://help.autodesk.com/view/ACD/2017/ENU/?guid=GUID-A809CD71-4655-44E2-B674-1FE200B9FE30

2017-02-22_6

and finally, autocad 2017 still installs two activex chm files on your hard drive with installation, the Guide and the Reference. You can also link to those.

2017-02-22_7

Autocad Ellipse

The Ellipse

2017-01-26_1

Autocad has an ellipse object. The AddEllipse method takes a center point, a second point which is the end of the major axis, and a factor autodesk calls RadiusRatio, which is just b / a. This is not the same thing as Eccentricity which is c / a, though similar but inverse and they both must be less than 1. I have not seen RadiusRatio in a math book. RadiusRatio gives a circle if it is equal to 1. If it is greater than 1 it throws an error. Eccentricity is a math term and gives a circle when it is zero. If it were 1 i believe the ellipse would collapse to a straight line.

To create an autocad vba ellipse with vertical axis, make the second point, MajorAxis, vertical above the center point. Autocad gives no indication where the Focus is. It has to be calculated from the values of A and B.

2017-01-26_2

Sub init_frm_ellipse()
a = frm_Ellipse.txt_a1
b = frm_Ellipse.txt_b1
End Sub

Sub horz_new_ellipse()
'AddEllipse(Center, MajorAxis, RadiusRatio)
'RadiusRatio must be less than or equal to 1
'MajorAxis is a relative point off the center, not an absolute point
Call connect_acad
Call init_frm_ellipse

Dim obj_ellipse As AcadEllipse
Dim ptctr(0 To 2) As Double
Dim pta(0 To 2) As Double
Call initpt(ptctr, 0, 0, 0)
Call initpt(pta, a, 0, 0)

Set obj_ellipse = acadDoc.ModelSpace.AddEllipse(ptctr, pta, b / a)
obj_ellipse.Update
End Sub

Sub vert_new_ellipse()
Call connect_acad
Call init_frm_ellipse

Dim obj_ellipse As AcadEllipse
Dim ptctr(0 To 2) As Double
Dim pta(0 To 2) As Double
Call initpt(ptctr, 0, 0, 0)
Call initpt(pta, 0, a, 0)

Set obj_ellipse = acadDoc.ModelSpace.AddEllipse(ptctr, pta, b / a)
obj_ellipse.Update
End Sub

The autodesk method advantage is that by specifying a center, then a relative point from the center for the end of the major axis, the ellipse can be turned to any angle. With some simple trig we can accept input in degrees and calculate the major axis vertex.

2017-01-27_1

 Function deg2rad(deg As Double) As Double
deg2rad = deg * Pi / 180
End Function

Sub init_frm_ellipse()
a = frm_Ellipse.txt_a1
b = frm_Ellipse.txt_b1
c = frm_Ellipse.txt_c1
End Sub

Sub new_ellipse()
'AddEllipse(Center, MajorAxis, RadiusRatio)
'RadiusRatio must be less than or equal to 1
'MajorAxis is a point, not a length
Call connect_acad
Call init_frm_ellipse

Dim obj_ellipse As AcadEllipse
Dim ptctr(0 To 2) As Double
Dim pta(0 To 2) As Double
Dim x1 As Double, y1 As Double

x1 = a * Cos(deg2rad(c))
y1 = a * Sin(deg2rad(c))

Call initpt(ptctr, 0, 0, 0)
Call initpt(pta, x1, y1, 0)

Set obj_ellipse = acadDoc.ModelSpace.AddEllipse(ptctr, pta, b / a)
obj_ellipse.Update
End Sub

we can move the ellipse off the center. The input for AddEllipse does not require an absolute point for MajorAxis. It takes a point relative to the center.

2017-01-28_1

Drawing the ellipse is straightforward. calculating the focus and end points to mark them requires some trig to accomodate the angled axes.


Sub new_ellipse()
'takes input from the form
'a major axis
'b minor axis
'd degree of major axis
'h and k, xy values for center of ellipse
'converts input to
'autocad method AddEllipse(Center, MajorAxis, RadiusRatio)
'RadiusRatio must be less than or equal to 1
'MajorAxis is a point relative from the center, not an absolute point
Call connect_acad
Call init_frm_ellipse ' gets the values from the form
Dim obj_ellipse As AcadEllipse
Dim obj_point As AcadPoint

Dim ctr(0 To 2) As Double
Dim pt_a(0 To 2) As Double
Dim x1 As Double, y1 As Double

x1 = a * Cos(deg2rad(d))
y1 = a * Sin(deg2rad(d))

Call initpt(ctr, h, k, 0)
Call initpt(pt_a, x1, y1, 0)

Set obj_ellipse = acadDoc.ModelSpace.AddEllipse(ctr, pt_a, b / a)
obj_ellipse.Update

'to plot points
Dim pt_a1(0 To 2) As Double
Dim pt_a2(0 To 2) As Double
Dim pt_b1(0 To 2) As Double
Dim pt_b2(0 To 2) As Double
Dim pt_f1(0 To 2) As Double
Dim pt_f2(0 To 2) As Double

Dim fx1 As Double, fy1 As Double, fx2 As Double, fy2 As Double
Dim ax1 As Double, ay1 As Double, ax2 As Double, ay2 As Double
Dim bx1 As Double, by1 As Double, bx2 As Double, by2 As Double

'c is the focal distance from ctr
c = (a ^ 2 - b ^ 2) ^ 0.5
fx1 = h + c * Cos(deg2rad(d))
fy1 = k + c * Sin(deg2rad(d))
fx2 = h - c * Cos(deg2rad(d))
fy2 = k - c * Sin(deg2rad(d))

bx1 = h + b * Cos(deg2rad(d + 90))
by1 = k + b * Sin(deg2rad(d + 90))

bx2 = h - b * Cos(deg2rad(d + 90))
by2 = k - b * Sin(deg2rad(d + 90))

ax1 = h + a * Cos(deg2rad(d))
ay1 = k + a * Sin(deg2rad(d))

ax2 = h - a * Cos(deg2rad(d))
ay2 = k - a * Sin(deg2rad(d))

Call initpt(pt_a1, ax1, ay1, 0)
Call initpt(pt_a2, ax2, ay2, 0)
Call initpt(pt_b1, bx1, by1, 0)
Call initpt(pt_b2, bx2, by2, 0)
Call initpt(pt_f1, fx1, fy1, 0)
Call initpt(pt_f2, fx2, fy2, 0)

Set obj_point = acadDoc.ModelSpace.AddPoint(ctr)

Set obj_point = acadDoc.ModelSpace.AddPoint(pt_a1)
Set obj_point = acadDoc.ModelSpace.AddPoint(pt_a2)

Set obj_point = acadDoc.ModelSpace.AddPoint(pt_b1)
Set obj_point = acadDoc.ModelSpace.AddPoint(pt_b2)

Set obj_point = acadDoc.ModelSpace.AddPoint(pt_f1)
Set obj_point = acadDoc.ModelSpace.AddPoint(pt_f2)
Update

End Sub

In astronomy, planets orbit around the sun in ellipses with the sun at one focus. To draw these orbits we need to input the different numbers but always draw one focus, the sun, at the origin.

2017-01-27_2

orbits of the nine planets (simplified with major axes aligned, no inclination). The sun and all planets are drawn full size, but the distances of the orbits are so vast they are not seen. this is much more fun to do yourself to zoom around and get a feel for the distance than to look at a screenshot.

the astronomy book gives the half major axis in (x 10^6 km), Orbital Eccentricity, and planet radius in km. those are the inputs. The value for Uranus caused Long and Double variable types to overflow but i had no issues using Currency data type. don’t base your senior thesis on this, i dont have supervision. it gives a visually correct orbit for pluto that it actually crosses inside neptune’s orbit because of pluto’s higher eccentricity. there are other 3D factors i do not take into consideration, inclination – ellipse tilt – and two other twists in 3D space. so neptune and pluto can never collide.

2017-01-27_3

Public Const xkm As Currency = 1000000

Sub solar_system()
Call connect_acad
'testCall planetary_ellipse(6, 0.5, 1)

Dim pt0(0 To 2) As Double
Call initpt(pt0, 0, 0, 0)

Dim obj_sphere As Acad3DSolid
'this is the sun
Set obj_sphere = acadDoc.ModelSpace.AddSphere(pt0, 696000)

'mercury
Call planetary_ellipse(57.9 * xkm, 0.206, 2440)

'venus
Call planetary_ellipse(108.2 * xkm, 0.007, 6052)

'earth
Call planetary_ellipse(149.6 * xkm, 0.017, 6378)

'mars
Call planetary_ellipse(227.9 * xkm, 0.093, 3397)

'jupiter
Call planetary_ellipse(778.4 * xkm, 0.048, 71492)

'saturn
Call planetary_ellipse(1427 * xkm, 0.054, 60268)

'too large
'uranus
Call planetary_ellipse(2871 * xkm, 0.047, 25559)

'neptune
Call planetary_ellipse(4498 * xkm, 0.009, 24764)

'pluto
Call planetary_ellipse(5906 * xkm, 0.249, 1195)

End Sub


Sub planetary_ellipse(a As Currency, e As Double, r As Long)
'a is major axis km
'e is eccentricity
'r is planetary equatorial radius in km

'AddEllipse(Center, MajorAxis, RadiusRatio)
'RadiusRatio must be less than or equal to 1
'MajorAxis is a point, not a length

Dim b As Double
Dim c As Double
Dim obj_ellipse As AcadEllipse
Dim obj_point As AcadPoint


Dim ctr(0 To 2) As Double
Dim f1(0 To 2) As Double
Dim f2(0 To 2) As Double
Dim pt_a(0 To 2) As Double
Dim pt_p(0 To 2) As Double
Dim a_vector(0 To 2) As Double

c = a * e
b = a * (1 - e ^ 2) ^ 0.5

Call initpt(ctr, c, 0, 0)
Call initpt(f1, 0, 0, 0)
Call initpt(f2, 2 * c, 0, 0)
Call initpt(pt_a, a + c, 0, 0)
Call initpt(pt_p, c - a, 0, 0)

Call initpt(a_vector, 1 * a, 0, 0)

Set obj_ellipse = acadDoc.ModelSpace.AddEllipse(ctr, a_vector, b / a)
obj_ellipse.Update

Dim obj_sphere As Acad3DSolid
Set obj_sphere = acadDoc.ModelSpace.AddSphere(pt_a, r)
Set obj_sphere = acadDoc.ModelSpace.AddSphere(pt_p, r)

End Sub

Autocad VBA Logo Turtle Graphics

Logo was a lisp like educational language designed to introduce children to coding. I believe there may be no serious impediments to implementing an experimental version in Autocad VBA. This is a work in process, first post is proof of concept. The full implementation is yet to be planned. I wont worry too much about deviating from standard logo methods or syntax. If i hit a problem that cannot be coded around, that will be information gained. I believe the concepts may turn out to be useful for more general VBA parametric autocad code.

For all of my projects, I code in an Excel XLSM file. I have a standard ACAD_CONNECT sub i use, and reference the Autocad Type Library in the Excel VBAProject. i have never downloaded the Autocad VBA implementation. It is not necessary to code Autocad VBA. I use the VBA editor provided routinely in Excel.

The fundamental element of turtle geometry is the current position of the pen, and the heading or direction it is pointing. This prototype will be 2D, so we need a global variable for the X and Y position, and a variable for the heading. We will keep heading in degrees and convert it in the low level subs to radians.

The first thing we will need is a line subroutine that takes logo style input – current point, distance, and heading – to draw the line and change the pen position to the end of the line. The user wont call this sub directly but will use std routines like Forward, PenUP, Right, Left, etc.

Option Explicit
 Public px As Double 'position x
 Public py As Double 'position y
 Public hxy As Double 'heading degree


Sub line_hd(x1 As Double, y1 As Double, dist As Double, heading As Double)
' call line_t(x1,y1,dist,heading)
' heading in degrees

Dim lineobj As AcadLine
Dim pt1(0 To 2) As Double
Dim pt2(0 To 2) As Double
Dim heading_radian As Double

pt1(0) = x1: pt1(1) = y1: pt1(2) = 0
heading_radian = heading * Pi / 180

'px and py are global position
px = px + dist * Cos(heading_radian)
py = py + dist * Sin(heading_radian)

pt2(0) = px: pt2(1) = py: pt2(2) = 0
Set lineobj = acadDoc.ModelSpace.AddLine(pt1, pt2)

Update
End Sub

standard logo subroutines FORWARD, RIGHT, LEFT and BACK to get started are pretty simple at this point. i dont have a PENUP, PENDOWN yet that will modify these.

Sub forward(dist As Double)
Call line_hd(px, py, dist, hxy)
End Sub

Sub right(deg As Double)
hxy = hxy - deg
End Sub

Sub left(deg As Double)
hxy = hxy + deg
End Sub

Sub back(dist As Double)
Dim heading_radian As Double
heading_radian = hxy * Pi / 180
px = px - (dist * Cos(heading_radian))
py = py - (dist * Sin(heading_radian))
End Sub

a sample user prototype sub and init sub helper.

 Sub init_turtle()
 Call connect_acad
 px = 0
 py = 0
 hxy = 0
 End Sub
 
 Sub to_honeycomb()
  init_turtle
 Dim i As Integer, j As Integer

For j = 1 To 3
For i = 1 To 6
forward 6
left 60
Next i

left 120
Next j

End Sub

2017-01-15_1

 Sub to_star()
 init_turtle
 Dim i As Integer
 
 For i = 1 To 5
 forward 6
 right 144
 Next i
 
 End Sub
 

2017-01-15_2

the circle routine according to python turtle graphics just takes a radius. from the position and heading of the turtle, it makes a 360 arc back to the starting point. if the radius is positive, it turns counterclockwise, if negative then opposite. the task then is to run a normal perpendicular off the heading vector the same distance as the radius to find the center.

this is a little messy, i dont think it will stay this way.

first a demo calling program, then the circle primitive code.

Sub test_circle()
init_turtle

For i = 1 To 21
forward 6
right 15 + i
forward 6
curcle 3
forward 3
curcle -3
forward 6
curcle -3
forward 3
curcle 3
Next i

End Sub

Sub curcle(radius As Double)
Call circle_turtle(px, py, radius, hxy)
End Sub


Sub circle_turtle(x1 As Double, y1 As Double, radius As Double, hxy As Double)
' circle wrapper
' call circle_hd(x1,y1,radius,heading)
' heading in degrees
Dim newheading As Double
Dim newheading_radian As Double
Dim Cx As Double, Cy As Double
Dim circleobj As AcadCircle
Dim pt2(0 To 2) As Double

If radius > 0 Then
newheading = hxy + 90
Else
newheading = hxy - 90
End If

newheading_radian = newheading * Pi / 180

'px and py are global position
'we are calculating circle center but not changing position
Cx = px + Abs(radius) * Cos(newheading_radian)
Cy = py + Abs(radius) * Sin(newheading_radian)
pt2(0) = Cx: pt2(1) = Cy: pt2(2) = 0

Set circleobj = acadDoc.ModelSpace.AddCircle(pt2, Abs(radius))

Update
End Sub

2017-01-16_1

more to come

Polyline SetBulge Arc factor

The Autocad VBA object AcadLWPolyline is made in straight line segments with AddLightWeightPolyline method using an array of coordinates. The LWPolyline object returned has a SetBulge method to change a straight line segment to an arc. Setbulge takes two parameters, the lower numbered index of the vertex that begins the segment, and a Bulge value. the Bulge value is explained thusly –

“The bulge is the tangent of 1/4 of the included angle for the arc between the selected vertex and the next vertex in the polyline’s vertex list. A negative bulge value indicates that the arc goes clockwise from the selected vertex to the next vertex. A bulge of 0 indicates a straight segment, and a bulge of 1 is a semicircle.”
https://knowledge.autodesk.com/search-result/caas/CloudHelp/cloudhelp/2017/ENU/AutoCAD-ActiveX/files/GUID-E1CE125E-AB3A-4645-B548-E43200064F9C-htm.html

The arc no matter what curvature it takes is always a part of a circle. Two lines drawn from the center to the vertexes define the included angle. This center moves along a line as the bulge factor changes. As the center gets closer to the arc, the angle gets larger. If the center moves far away the included angle gets small, the tangent of that angle is small, the arc is nearly a straight line, and the Bulge factor is small.

The gist of the code. Vertexes start numbering with zero.

Dim plineObj As AcadLWPolyline
Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points_array)
plineObj.SetBulge 3, -0.5

what does an even number 0.5 Bulge factor give?
2017-01-11_1

what Bulge factor would give an included angle of 90 deg?

2017-01-11_2

since B = TAN(PI/8) this can be entered directly in code

Sub B2_test()
Call connect_acad
Dim pt As Variant

pt = Array(0, 0, Cos(Pi / 4), Sin(-Pi / 4), Cos(Pi / 4), Sin(Pi / 4))
Call draw_array(pt)
global_plineobj.SetBulge 1, Tan(Pi / 8)

End Sub

To create a rounded fillet the vertexes of the arc have to be encoded in the square edge polyline, then rounded.
The B value for 90 degrees is 90/4 or 1/4 * pi/2. Here is a program to create a filleted rectangle of any size with any radius at any location. (the draw_array sub is posted previously)

2017-01-13_1

Sub B2_test_rectangle()
Call connect_acad
Dim pt As Variant
 Dim x1 As Double, x2 As Double, x3 As Double, x4 As Double
 Dim y1 As Double, y2 As Double, y3 As Double, y4 As Double
 Dim A As Double, B As Double, R As Double, Dx As Double, Dy As Double
'A is width X
'B is height Y
'R is fillet radius
'Dx and Dy are coordinates for lower left corner

A = 4
B = 5
R = 1
Dx = 2
Dy = 2
 
 x1 = Dx
 x2 = Dx + R
 x3 = A + Dx - R
 x4 = A + Dx
 
 y1 = Dy
 y2 = Dy + R
 y3 = B + Dy - R
 y4 = B + Dy
 
pt = Array(x2, y1, x3, y1, x4, y2, x4, y3, x3, y4, x2, y4, x1, y3, x1, y2)
Call draw_array(pt)
global_pline.SetBulge 1, Tan(Pi / 8)
global_pline.SetBulge 3, Tan(Pi / 8)
global_pline.SetBulge 5, Tan(Pi / 8)
global_pline.SetBulge 7, Tan(Pi / 8)

End Sub

A slot sub would simply draw a rectangle and use a B factor for the ends to give a 180 degree arc. Here is a routine for both vertical and horizontal slots. This could be combined into one program with a switch or flag. We would also call them with the dimensions as parameters. The B factor is the TAN of one fourth of 180 or pi/4.

2017-01-13_2

Sub B2_horz_slot()
Call connect_acad
Dim pt As Variant
 Dim x1 As Double, x2 As Double, y1 As Double, y2 As Double
 Dim A As Double, B As Double, Cx As Double, Cy As Double
'A is length
'B is width
'Cx and Cy are center coordinates

A = 2
B = 0.5
Cx = 3
Cy = 3
 
 x1 = Cx - A / 2
 x2 = Cx + A / 2
 
 y1 = Cy - B / 2
 y2 = Cy + B / 2
 
pt = Array(x1, y1, x2, y1, x2, y2, x1, y2)
Call draw_array(pt)
global_pline.SetBulge 1, Tan(Pi / 4)
global_pline.SetBulge 3, Tan(Pi / 4)
Call draw_point(Cx, Cy, 0) 'this draws a point for reference
End Sub


Sub B2_vert_slot()
Call connect_acad
Dim pt As Variant
 Dim x1 As Double, x2 As Double, y1 As Double, y2 As Double
 Dim A As Double, B As Double, Cx As Double, Cy As Double
'A is length
'B is width
'Cx and Cy are center coordinates

A = 2
B = 0.5
Cx = 3
Cy = 3
 
 x1 = Cx - B / 2
 x2 = Cx + B / 2
 
 y1 = Cy - A / 2
 y2 = Cy + A / 2
 
pt = Array(x1, y1, x2, y1, x2, y2, x1, y2)
Call draw_array(pt)
global_pline.SetBulge 0, Tan(Pi / 4)
global_pline.SetBulge 2, Tan(Pi / 4)
Call draw_point(Cx, Cy, 0)
End Sub

autodesk (or somebody) made the B factor the tan of one fourth the included angle. As the included arc varies from zero to almost 360, one fourth of that angle varies from zero to almost 90, and the tangent of that angle (Bulge Factor B) varies from zero to infinity. Because of the imprecision of doubles, Tan(Pi/2) should give an error, the slope of a vertical line, divide by zero, but the imprecision causes an arc with a very large radius.

Autocad VBA Parameters -3-

A non-trivial VBA parametric project requires some structure to re-use standard techniques and a guide drawing to be made with user parameters identified that specifies the point values to be drawn. This sample project is a sheet metal frame that would be used to cap a hole. There are only two parts, top/bottom and side, but they are drawn both in front assembly and laid out flat before bending, so there are 4 basic drawing sub-routines. The drawing subroutines create geometry. Their only other job is to initialize bounding box variables so the calling program has the option to move into assembly, block, and/or rotate.

The parts are always drawn with lower left corner at or near 0,0. The master drawing is created manually before the programming is started. If carefully done, and revised until it works as needed, it will make the programming much easier.

2016-12-31_1

Give each project its own module. It solves naming issues if each project is given a simple project ID, then prefix all the subs with the ID. The draw subs are at the bottom and the controlling program at the top. The draw subs are completed first, all in a similar manner. Again it makes programming much simpler if all the controlling sketches are laid out consistently and thoroughly. The only variables passed are the user variables. Calculations are made in the drawing sub. The sketches should be consistent – variable D1 in one sketch is the same value D1 in another sketch.


Sub B1_chan_top_bent(A As Double, D As Double, E As Double)
Dim pt As Variant
Dim A1 As Double, A2 As Double
      A1 = A + D + D
      A2 = A + D

'bounding box pt_ll and pt_ur are global vars
Call initpt(pt_ll, -1, -1, 0)
Call initpt(pt_ur, A1 + 2, D + 2, 0)
   
pt = Array(0, E, D, E, D, 0, _
            A2, 0, A2, E, A1, E, _
            A1, D, 0, D)
Call draw_array(pt)

acadDoc.ActiveLayer = acadDoc.Layers.Item("Hidden")
Call line(D, E, A2, E)

'each drawing sub re-sets current layer to 0
acadDoc.ActiveLayer = acadDoc.Layers.Item("0")
Update
End Sub


Sub B1_chan_side_bent(B As Double, D As Double, E As Double)
Dim pt As Variant
Dim B1 As Double
B1 = B + E + E

'bounding box
  Call initpt(pt_ll, -1, -1, 0)
  Call initpt(pt_ur, B1 + 2, D + 2, 0)

pt = Array(0, 0, B1, 0, B1, D, 0, D)
Call draw_array(pt)

acadDoc.ActiveLayer = acadDoc.Layers.Item("Hidden")
Call line(0, E, B1, E)

acadDoc.ActiveLayer = acadDoc.Layers.Item("0")
Update
End Sub


Sub B1_chan_top_flat(A As Double, C As Double, D As Double, E As Double)
Dim pt As Variant
Dim A1 As Double, A2 As Double, C1 As Double, C2 As Double, D1 As Double
    A1 = A + D + D
    A2 = A + D
    D1 = D - E
    C1 = C + D1
    C2 = C + D1 + D1
    
 'bounding box
   Call initpt(pt_ll, -1, -1, 0)
   Call initpt(pt_ur, A1 + 2, C2 + 2, 0)
   
pt = Array(0, 0, A1, 0, A1, D1, _
        A2, D1, A2, C1, A1, C1, _
        A1, C2, 0, C2, 0, C1, _
        D, C1, D, D1, 0, D1)
Call draw_array(pt)

acadDoc.ActiveLayer = acadDoc.Layers.Item("UP")
Call line(D, D1, A2, D1)
Call line(D, C1, A2, C1)

acadDoc.ActiveLayer = acadDoc.Layers.Item("0")
Update
End Sub



Sub B1_chan_side_flat(B As Double, C As Double, D As Double, E As Double)
Dim pt As Variant
Dim B1 As Double, C1 As Double, C2 As Double, D1 As Double
B1 = B + E + E
D1 = D - E
C1 = C + D1
C2 = C + D1 + D1

'bounding box
 Call initpt(pt_ll, -1, -1, 0)
 Call initpt(pt_ur, B1 + 2, C2 + 2, 0)

'outside box
pt = Array(0, 0, B1, 0, B1, C2, 0, C2)
Call draw_array(pt)

acadDoc.ActiveLayer = acadDoc.Layers.Item("UP")
Call line(0, D1, B1, D1)
Call line(0, C1, B1, C1)

acadDoc.ActiveLayer = acadDoc.Layers.Item("0")
Update
End Sub

These can be called in any order. In this project i call the bent pieces first. I block them, then move them to an assembly position, using an arbitrary location (K, K). The side piece is drawn horizontal, so it is first rotated and moved about the same point. Again these points are located first on the sketches. The parts are blocked with a sub that accepts the bounding box coordinates, a name and a point for insert point. That routine works with any similar project. It creates a selection set using the bounding box, creates the block with name and insert point, adds the selection set entities to the block, erases the original entities and finally inserts the block. It assigns the block to a global var so the calling program can move it. These routines are in their own module shared by multiple projects.

Sub make_ss_blk(pt_ll() As Double, pt_ur() As Double, strblkname As String, pt_insert() As Double)
  'creates new ss, adds items to it with a crossing window
  'creates new block, adds ss to blk with counting loop
  'deletes original entities and inserts the block
  'creates an object reference to the block objpersistent for moving/rotating
  
    Dim objss As AcadSelectionSet
    Dim objBlock As AcadBlock
    Dim i As Integer
        
    Call addss("my_block")
    Set objss = acadDoc.SelectionSets.Item("my_block")
       objss.Select acSelectionSetCrossing, pt_ll, pt_ur
  
 ' make_blk(objss, strblkname, pt_insert)
    On Error Resume Next
    Set objBlock = acadDoc.Blocks.Item(strblkname)
    objBlock.Delete
    On Error GoTo 0
    
    Set objBlock = acadDoc.Blocks.Add(pt_insert, strblkname)
    
    ReDim Obj(0 To objss.Count - 1) As AcadObject
     'Copy each object selected in the block
    For i = 0 To objss.Count - 1
    Set Obj(i) = objss(i)
    Next i
    acadDoc.CopyObjects Obj, objBlock
   
    objss.Erase
    objss.Delete
    
    Set objpersistent = acadDoc.ModelSpace.InsertBlock(pt_insert, strblkname, 1, 1, 1, 0)
     
End Sub

Sub addss(strname As String)
    Dim objss As AcadSelectionSet
   On Error Resume Next
    If "" = strname Then
    Exit Sub
    End If
    
    Set objss = acadDoc.SelectionSets.Item(strname)
    objss.Delete
    Set objss = acadDoc.SelectionSets.Add(strname)
    If objss Is Nothing Then
    MsgBox "unable to add " & strname
    Else
    'MsgBox "added"
    End If
End Sub

The main calling program will vary depending on interface. Here is the basic one with variable values called out near the top.


Option Explicit
'ProjID B1
'Project Name - Inside Cap Channel
'ProjDesc - to cap existing hole
'a b c d e

Public Const Pi As Double = 3.14159265359
Public Const halfPI = Pi / 2

Public pt0(0 To 2) As Double
Public pt_ll(0 To 2) As Double
Public pt_ur(0 To 2) As Double

Public objss As AcadSelectionSet
Public objent As AcadEntity
Public objpersistent As AcadEntity


Sub B1_draw_inside_cap_chan_assy()

Dim pt1(0 To 2) As Double
Dim pt2(0 To 2) As Double
Dim K As Double
K = 50
Call init_part

'assy vars
Dim A As Double, B As Double, C As Double, D As Double, E As Double
'A is X, B is Y, C is ID THK, D is BENT FLG, E is GA

A = 24
B = 36
C = 4.125
D = 2.5
E = 0.125

Call B1_chan_top_bent(A, D, E)
Call make_ss_blk(pt_ll, pt_ur, "B1_chan_top", pt0)
Call initpt(pt1, A / 2 + D, 0, 0)
Call initpt(pt2, K, K + B / 2, 0)
objpersistent.Move pt1, pt2

Call B1_chan_side_bent(B, D, E)
Call make_ss_blk(pt_ll, pt_ur, "B1_chan_side", pt0)
Call initpt(pt1, B / 2 + E, 0, 0)
Call initpt(pt2, K + A / 2, K, 0)
objpersistent.Rotate pt1, -halfPI
objpersistent.Move pt1, pt2

Call B1_chan_top_flat(A, C, D, E)
addss ("FlatPattern")
Set objss = acadDoc.SelectionSets.Item("FlatPattern")
objss.Select acSelectionSetWindow, pt_ll, pt_ur

Call initpt(pt2, 0, 48, 0)
    For Each objent In objss
    objent.Move pt0, pt2
    Next

Call B1_chan_side_flat(B, C, D, E)
addss ("FlatPattern")
Set objss = acadDoc.SelectionSets.Item("FlatPattern")
objss.Select acSelectionSetWindow, pt_ll, pt_ur

Call initpt(pt2, 0, 24, 0)
    For Each objent In objss
    objent.Move pt0, pt2
    Next

Call initpt(pt2, K, K, 0)
Call cap_chan_sect(C + (2 * E), D, E)
objpersistent.Move pt0, pt2

Update
End Sub

This creates –
2016-12-31_2

The section view is a straightforward drawing sub

Sub cap_chan_sect(C As Double, D As Double, E As Double)
Dim pt As Variant
   Call initpt(pt_ll, -1, -1, 0)
   Call initpt(pt_ur, D + 2, C + 2, 0)
   
pt = Array(0, 0, D, 0, D, E, E, E, E, C - E, D, C - E, D, C, 0, C)
Call draw_array(pt)

Update
End Sub

The init-part sub is simply because i like to be able to run programs in a completely new blank drawing. it creates layers, but also makes the initial connection between excel VBA code and autocad.

Sub init_part()
 Call initpt(pt0, 0, 0, 0)
 Call connect_acad
 Call newlayer("UP", 4, acLnWtByLwDefault, "Continuous")
 Call newlayer("Down", 6, acLnWtByLwDefault, "Hidden")
 Call newlayer("Hidden", 6, acLnWtByLwDefault, "Hidden")
 acadDoc.ActiveLayer = acadDoc.Layers.Item("0")
End Sub

Anything you can draw manually with specificity and clearly defined variables you can automate. It is only slightly more effort to automate dimensioning. Practice will refine your technique.