A Parameter Toolbox

The last little project I did, parts of it below, took about 12-15 hours in Visual Studio (COM) and on completion I dumbed it down and converted it to Excel VBA-Autocad, about 3-4 hours for that. The code does not have to rewritten. The improvements of VB.net have to be undone.

Visual studio is a vastly better programming environment than VBA. But the problem is distribution. If the distributed XLSM file has the wrong version of autocad referenced, Excel will open the dialog to change it when first opened. With an EXE its just a dead end. Netload does seem to have some flexibility in this area. I have been working on it. I think I have some success driving parts in autocad from a form with a draw button and textbox number input with autocad.net, so that is the next direction.

Nevertheless I am using Visual Studio to automate Autocad with COM (ActiveX) and, so far, it works great. Essentially I am getting full functionality just by pasting from excel VBA and correcting the syntax changes. But I can’t share it with any other autocad version.

Below are some thoughts on developing a Visual Studio toolbox template and typical methods for multi-view 2D parametrics, with COM, not dotnet.

The basic starting technique is to sketch the part a view at a time on an XY grid. On the sketch, draw a vertical line at each X coordinate needed, X1, X2 etc. Do the same thing for the Y axis. Now link those to the parameters.

For instance a sheetmetal formed pan with a double bend at each side – You will have LENGTH, WIDTH, EDGE and FLANGE. The entire thing is described with 4 variables.

to draw a face view –

X0 = 0
X1 = FLANGE
X2 = WIDTH – FLANGE
X3 = WIDTH

The Y values are the same except LENGTH is substituted for WIDTH.

Then put those together to create point objects – an array of 3 doubles. Its much simpler to create the x, y values first then create the point objects.

in this simplest case, I have a box sub and the creation of the points is buried in there.

a slightly more complicated side view starts to show how this helps manage the complexity.

While that is an ugly point list, hard to read, it was easy to write. The figure is double line, in case its hard to tell. I am hard coding the thickness at 1/16 inch but that could also be a variable. Start at X1,Y1 and go counter-clockwise around.
In a multi-view drawing, how do we get the side view out to the side? we draw it in place by just adding a displacement to the X values. If the view is above, we add to the Y values. If its up and over, we add to both.

The displacement will vary on a lot of factors, mainly the dimensions of the front view and the dimension space.

Without dimensions, its just a sketch. The main programming toolbox for simple 2D parametrics contains wrappers or helpers for

Line
Polyline
Circle
Slot (in this particular example)
A point creator (essential with VBA but not hardly necessary with VB.NET)
Selection Sets (for making a Block)
Mtext
Linear Dimension, horizontal and vertical
Making a Block

Make the form look the way you want, change all the textbox label text at the same time with the idea they will all become global variables. Move things around, then change all the textbox names at the same time. Declare global variables for everything on the screeen, and make a sub to Get_All_Vars. Load defaults either by typing values into the properties box or in form_load.

I have one button to draw all views, with check boxes to turn on or off. the button is simple.

   Private Sub Btn_Draw1_Click(sender As Object, e As EventArgs) Handles Btn_Draw1.Click
        get_all_vars()  'get all vars from form
        draw_init()     'set layer, dimstyle

        If g_v1 Then view1()
        If g_v2 Then view2()
        If g_v3 Then view3()
        If g_v4 Then view4()
        If g_v5 Then view5()

        acadApp.Update()
    End Sub


    Sub draw_init()
        pt0 = Pt(0, 0, 0)
        acadDoc.SetVariable("clayer", "0")
        acadDoc.SetVariable("textstyle", "ArialN")

        'g_sc is from form
        Dim str As String = "PP-" & g_sc
        acadDoc.ActiveDimStyle = acadDoc.DimStyles.Item(str)
        acadDoc.SetVariable("LTSCALE", 0.5 * g_sc)
    End Sub

Get_all_vars and draw_init are in the button, so the user can change the form and draw. Everything read in from the form is saved to a global variable. This makes it easier, there is no decision making over how to pass necessary variables. This is a small program.

Another expediency is the loading of drawing elements. I like to be able to start a program like this from a completely blank drawing. I load in a template drawing when the form loads. The template drawing has layer, dimension style, and text style information only. I have a half dozen dimension styles, all identical except for the dimension scale, and I name them pp-12, pp-16, pp-24 etc and set to the proper one from the scale on the form.

    Sub Insert_delete()
        Dim strpath As String = "c:\prog\acad\"
        Dim strfile As String = "pnl_template.dwg"
        pt0 = Pt(0, 0, 0)
        Dim blockrefObj As AcadBlockReference
        blockrefObj = acadDoc.ModelSpace.InsertBlock(pt0, strpath & strfile, 1, 1, 1, 0)
        blockrefObj.Delete()
    End Sub

The first thing that has to be done is make a connection to autocad. you cannot make any autocad moves before connecting. Start_cad is called from Form_Load. It has to be first and it doesnt need to occur everytime the draw button is pushed.

 Public Sub start_cad()
        m_ProgID = "AutoCAD.Application.22"
        Call Connect_acad(m_ProgID)

        Insert_delete()

    End Sub

    Public Sub Connect_acad(strProgID As String)
        acadApp = Nothing
        'Dim strProgId As String = "AutoCAD.Application.22"

        Try         '' Get a running instance of AutoCAD
            'acadApp = GetObject(, strProgId)
            acadApp = CType(GetObject(, strProgId), AcadApplication)

        Catch
            Try     '' Create a new instance of AutoCAD
                acadApp = CType(CreateObject(strProgId), AcadApplication)

            Catch ex As Exception
                MsgBox(ex.Message)
                Exit Sub
            End Try
        End Try

        acadApp.Visible = True  '' Display the application
        ' MsgBox("Now running " & acadApp.Name & " version " & acadApp.Version)

        'load whatever globals needed based on acadapp
        acadDoc = acadApp.ActiveDocument
        acadMs = acadApp.ActiveDocument.ModelSpace
        ThisDrawing = acadApp.ActiveDocument

    End Sub

the actual drawing subs are called View1, View2 etc. that is where we declare x and y values and branch off to the wrappers and helpers.


    Function Line1(pnt1() As Double, pnt2() As Double, Optional strlayer As String = "none") As AcadLine
        ' line wrapper absolute pt args with optional layer
        Dim lineobj As AcadLine
        lineobj = acadDoc.ModelSpace.AddLine(pnt1, pnt2)

        If strlayer <> "none" Then
            lineobj.Layer = strlayer
        End If
        g_pt = pnt2
        g_line = lineobj
        Return lineobj
    End Function

  Sub Mtxt1(ptx() As Double, dblwidth As Double, str As String, Optional height As Double = 0.125, Optional layer As String = "0")
        'uses optional height , layer
        g_mtxt = acadDoc.ModelSpace.AddMText(ptx, dblwidth, str)
        g_mtxt.Layer = layer
        g_mtxt.Height = height
    End Sub

    Sub dimh(pt1() As Double, pt2() As Double, dimlocpt() As Double, Optional stylename As String = "none")
        Dim dimObj As AcadDimRotated
        dimObj = acadDoc.ModelSpace.AddDimRotated(pt1, pt2, dimlocpt, 0)
        dimObj.Layer = "Dim"

        If stylename <> "none" Then
            dimObj.StyleName = stylename
            dimObj.Update()
        End If
        g_dim = dimObj
    End Sub

    Sub dimv(pt1() As Double, pt2() As Double, dimlocpt() As Double, Optional stylename As String = "none")
        Dim dimObj As AcadDimRotated
        dimObj = acadDoc.ModelSpace.AddDimRotated(pt1, pt2, dimlocpt, PI / 2)
        dimObj.Layer = "Dim"

        If stylename <> "none" Then
            dimObj.StyleName = stylename
            dimObj.Update()
        End If
        g_dim = dimObj
    End Sub

I have found it easier to have separate subs for vertical and horizontal dims. With dimensions the endpoints are pretty straightforward, but the dimension line also has to be located. In old lisp routines, I always queried the dimstyle to see what the dimscale was. a half inch is a good distance to use between the part and the dimension line and between dimension lines. this is scaled times the overall scale factor, which is a textbox on the form. the location of the side views also use the scale to know how much space the dimensions take.

The dimension lines can be located with a Polarpoint type function. This works just like autocad’s built-in Utility.PolarPoint


    Function ppt(pnt() As Double, ang As Double, dist As Double) As Double()
        Dim pnt1() As Double
        Dim x, y As Double
        x = dist * Math.Cos(Deg2rad(ang))
        y = dist * Math.Sin(Deg2rad(ang))
        pnt1 = Pt(pnt(0) + x, pnt(1) + y, 0)
        Return pnt1
    End Function

if we are dimensioning a box with corners at pt0,1,2,3
g_sc is a global scale variable from form (default 16).

Dim spc As Double = 0.5 * g_sc

pt0 = Pt(0,0,0)
pt1 = Pt(pnl_wid, 0, 0)
pt2 = Pt(pnl_wid, pnl_len, 0)
pt3 = Pt(0, pnl_len, 0)

dimh(pt0, pt1, ppt(pt0, 270, 2 * spc))
dimv(pt1, pt2, ppt(pt1, 0, 2 * spc))
dimh(pt3, pt2, ppt(pt3, 90, 2 * spc))
dimv(pt0, pt3, ppt(pt0, 180, 2 * spc))

Since these are overall dimensions, that puts them two spaces away so we can get another line in closer for details.

A basic tool for putting in a variable number of holes or slots at regular intervals and centering them on an any-size edge, is here,
L = N * C + 2R

I like to block drawing elements that are supposed to stay together. The front view of these panels are often put together side by side to form walls. if a block is made the assembly can be put together with ease. making a block in autocad activex is usually described as drawing in a BlockSpace, just like you would otherwise draw in a ModelSpace. That sounds fine in theory, but in practice it presents a problem to the wrapper helpers who all have something like

lineobj = acadDoc.ModelSpace.AddLine(pnt1, pnt2)

built into them. In Lisp i did have a switch on the argument list to draw in either ms or bs. in vb i am not sure that could be made to work so easily. Fortunately there is another method, and it allows much more flexibility.

the gist of the code is this

 Dim B1 As AcadBlock
 B1 = acadDoc.Blocks.Item(strName)
 Dim items(i) As AcadEntity
'populate a selection set
'transfer the selection set to array Items
 acadDoc.CopyObjects(items, B1)

With that method we can draw in modelspace, select the items into a selection set with crossing or window, and send the selection set to the block making routine.

When making blocks there are 3 possible scenarios,
– the block name is not found and there are no complications, the new block is made, the items erased that formed the block and the block inserted,
– the block name is found but the block is not currently inserted, the old block definition can be deleted and proceed as above.
– the block name is found and there is an insert on the drawing, a message box is raised telling the user the block name is in use, the individual items are left on the screen, but there is no attempt to block.

Make_Block is a boolean function, so it indicates to the calling program whether it was successful or not. if succesful the calling program deletes the entities and inserts the block, if not then it does nothing.

the Try Catch error checking in VB.NET made this part of the code simpler than VBA.

    Function Add_ss(strName As String) As AcadSelectionSet
        'adds new empty named selection set
        Dim ss As AcadSelectionSet
        Try
            ss = acadDoc.SelectionSets.Item(strName)
            ss.Clear()
        Catch
            'accessing ss created an error
            ss = acadDoc.SelectionSets.Add(strName)
        End Try
        Return ss
    End Function

    '' function ss_x - return selection set from crossing window
    Function ss_x(ss As AcadSelectionSet, pt1() As Double, pt2() As Double) As AcadSelectionSet
        'items not visible do not select
        acadApp.Update()
        acadApp.ZoomAll()
        ss.Select(AcSelect.acSelectionSetCrossing, pt1, pt2)
        Return ss
    End Function

 Sub make_block_assy(strblk As String, pnt1() As Double, pnt2() As Double)
        Dim sset As AcadSelectionSet
        sset = Add_ss("SSBLOCK")
        sset = ss_x(sset, pt1, pt2)

        Dim result As Boolean
        result = Make_blk(sset, strblk)

        If result Then
            sset.Erase()
            sset.Clear()
            sset.Delete()
            g_entity = CType(acadDoc.ModelSpace.InsertBlock(pt0, strblk, 1, 1, 1, 0), AcadEntity)
            g_entity.Layer = "0"
        End If
    End Sub


    ''  function make_blk 
    ''  input - acadselectionset, str name of block
    ''  if new block name - make block, return true
    ''  if old block name with no inserts - delete old reference then make block, return true
    ''  if old block name with inserts - return false
    Function Make_blk(ss As AcadSelectionSet, strName As String) As Boolean
        Dim result As Boolean
        Dim B1 As AcadBlock
        Dim i As Integer

        Try
            B1 = acadDoc.Blocks.Item(strName)
            Try
                ' Found block, try to delete"
                B1.Delete()
            Catch ex As Exception
                ' delete generated an error, do nothing and exit function 
                MsgBox("looks like there is an insert, I did not make a new block")
                result = False
                Return result
            End Try
        Catch ex2 As Exception
            ' no block found, adding
        End Try

        B1 = acadDoc.Blocks.Add(pt0, strName)
        i = ss.Count - 1
        Dim items(i) As AcadEntity
        Dim item As AcadEntity

        'loop ss and add acad entity objects to array
        For i = 0 To ss.Count - 1
            item = ss.Item(i)
            items(i) = item
        Next i

        'populate block with items in the array
        acadDoc.CopyObjects(items, B1)
        result = True
        Return result
    End Function

I left out a few details, I have 5 views drawn, the 6th would be a flat pattern layout, before bending.

Specific method for parametric drawing programs

The hard part of coding parametric drawing program whether in lisp or VBA is managing the large number of points. The program turns into many lines of hard to read data apparently randomly named. A sketch has to be made with points labeled and equations or formulas entered. It all might make sense during the coding, but probably won’t a few weeks later when a change has to be made even if the sketch(s) is found. It won’t be obvious how the points are calculated or why lines are drawn from pt7 to pt21 to pt3. There is no one right way but I have recently worked on both lisp and vba programs and have some specific but not comprehensive suggestions. This is a special theory for creating the xy data but not a general theory for the entire program.

There are two basic ways to manage your drawing subroutine. It can accept points or xy data. Try both ways. Both methods need xy data.

In Lisp I use Visual Lisp objects rather than the “command” method. The object method can draw directly in to a block definition, and it can directly change the layer property. It requires a point object, but that can be created and passed as a parameter or the xy data can be passed and the point created in the subroutine.

For lisp I made a point creation routine and passed points to the subroutine which runs the Addline method.

(defun pt ( x y ) (vlax-3d-point x y 0))

In a very simple box example this gets called as

(setq pt1 (pt 0 0) pt2 (pt L 0) pt3 (pt L W) pt4 (pt 0 W))

Then the line routine would be

(defun linep (pt1 pt2 obj lyr / lineobj)
(setq lineobj (vla-AddLine obj pt1 pt2))
(vla-put-layer lineobj lyr) )

And be called as

(linep pt1 pt2 ms "hidden")

Or you could pass xy data

(defun line (x1 y1 x2 y2 obj lyr / pt1 pt2 lineobj)
(setq pt1 (vlax-3d-point x1 y1 0)
pt2 (vlax-3d-point x2 y2 0))
(setq lineobj (vla-AddLine obj pt1 pt2))
(vla-put-layer lineobj lyr) )

In VBA every variable has to be declared previous to use, so you might lean towards passing xy data. Assume you want to draw a notched rectangle and make it a polyline. You make a sub specifically for this purpose. After setting the xy data coordinates, any six vertex closed polyline can be drawn with

Call p6_box(x1, y1, x2, y1, x2, y2, x3, y2, x3, y3, x1, y3)

Sub p6_box(p1 As Double, p2 As Double, p3 As Double, p4 As Double, p5 As Double, p6 As Double, _
p7 As Double, p8 As Double, p9 As Double, p10 As Double, p11 As Double, p12 As Double)

Dim objent As AcadLWPolyline
Dim pt(0 To 11) As Double
pt(0) = p1: pt(1) = p2
pt(2) = p3: pt(3) = p4
pt(4) = p5: pt(5) = p6
pt(6) = p7: pt(7) = p8
pt(8) = p9: pt(9) = p10
pt(10) = p11: pt(11) = p12
Set objent = acadDoc.ModelSpace.AddLightWeightPolyline(pt)
objent.Closed = True
Set obj_Acad_Entity = objent
End Sub

This makes no sense without a sketch but the sub p6_box can draw any closed polyline with 6 points configured any way you need it.

2018-01-13_2.jpg

Our notched box is L X W with an A X B notch, drawn with the lower left corner at 0,0. There are 3 X coordinates and 3 Y coordinates.
X1=0 , X2=L-B , X3=L
Y1=0 , Y2=A , Y3=W

You can turn this box around any way you wish, move the notch to the middle, put a hole in the middle. Just label xy coordinates as needed in order from the origin. This is how you organize your xy data without duplication in a straightforward way. Sometimes its convenient to also label points, sometimes its not required, but the xy data must always be figured from the parameters as the first step.

In VBA we would probably draw in counterclockwise order.

Call p6_box(x1, y1, x2, y1, x2, y2, x3, y2, x3, y3, x1, y3)

Now it should make sense. The xydata starts at the origin. Subroutines can be written so declared point variables are not required, or required. If you have a lot of sub-routines, just declare your x1, x2, etc as public to avoid re-declaring.

In programming 101 they strongly suggest that your subroutines be simple and single purpose. Just about every autocad parametric program I have seen or written has been a mess at the actual geometry creation level. For instance in this example, the parameters A and B, L and W may need to have complicated formulas behind them. Put those upstream of the actual sub-routine that draws the geometry. Make the geometry creation as simple as possible. Pass the actual parameters if possible, do not develop them. Interface is top down thinking, but geometry is bottom up.
Such as

Sub draw_notch_box(W As Double, L As Double, A As Double, B As Double)
x1 = 0
x2 = L - B
x3 = L
y1 = 0
y2 = A
y3 = W
Call p6_box(x1, y1, x2, y1, x2, y2, x3, y2, x3, y3, x1, y3)
End Sub

You will be able to read that next year if you remember that xy data starts at the origin.

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.

Autocad VBA Parametrics – 2 – Polyline Method

The autocad lightweightpolyline is the method of choice for drawing parametric plane figures if it is an option. But assembling an array of 30 or so points can be tedious. Here is a sub i wrote several months ago, and to be honest, it is a complete mystery now. the only way i can work on it is to plot it out and start listing points. So i am going to generalize the method and come up with an easier standard procedure for drawing parametric polyline objects.


Sub orig_OS_skin(A As Double, B As Double)
    Dim objent As AcadLWPolyline
    Dim pt(1 To 36) As Double
    
    pt(1) = 0.21875: pt(2) = A + 0.5 - 1
    pt(3) = 0.21875: pt(4) = A + 0.5
    pt(5) = 0: pt(6) = A + 0.5
    pt(7) = 0: pt(8) = 0
    pt(9) = B + 0.5 - 1.25: pt(10) = 0
    pt(11) = B + 0.5 - 1.0625: pt(12) = 0.1875
    pt(13) = B + 0.5: pt(14) = 0.1875
    pt(15) = B + 0.5: pt(16) = 0.40625
    pt(17) = B + 0.5 - 0.875: pt(18) = 0.40625
    pt(19) = B + 0.5 - 0.875: pt(20) = 0.34375
    pt(21) = B + 0.5 - 0.0625: pt(22) = 0.34375
    pt(23) = B + 0.5 - 0.0625: pt(24) = 0.25
    pt(25) = B + 0.5 - 1.08839: pt(26) = 0.25
    pt(27) = B + 0.5 - 1.27589: pt(28) = 0.0625
    pt(29) = 0.0625: pt(30) = 0.0625
    pt(31) = 0.0625: pt(32) = A + 0.5 - 0.0625
    pt(33) = 0.15625: pt(34) = A + 0.5 - 0.0625
    pt(35) = 0.15625: pt(36) = A + 0.5 - 1
    Set objent = acadDoc.ModelSpace.AddLightWeightPolyline(pt)
    objent.Closed = True
    objent.Update
       
    Set objpersistent = objent
End Sub

the first task is to draw a single polyline object. You cannot automate an object if you cannot draw it. if you have drawn it 100 times you will do a better job automating it than if you have barely drawn it. Just like plotting a curve, place it as conveniently as possible at 0,0. Visualize it sitting on the xy axis. Keep your parametric variables as convenient as possible. Start listing points by moving in the direction of the positive X axis. sweep around the screen in a counterclockwise direction as a standard procedure. Locate the first point at 0,0 if possible. The second point should be to the right. Use excel to list just the X values. it is simpler to separate the listings of X and Y values and measure or calculate them separately. Work in the parametric calculations as you go. Make dimensions and measurements on the drawing as needed. After you have gone all around the object listing the X values, do the same thing for Y. This is the key step.

2016-09-18_1

The program listing above that dimensions an array (1 to 36) for 18 points then loads a value into each index location is the brute force normal straightforward approach. We can instead create a polyline wrapper program. The array function only requires the data to be separated by commas. the Polyline method will not use that array directly, but we can create a transfer method in the wrapper. the wrapper will also measure the length of the array. Create a new sub and paste the values just entered into the spreadsheet into the sub.

Sub new_poly_draw(A As Double, B As Double)
Dim pt As Variant
pt = array(

Paste here

Call draw_array(pt)
End Sub
Sub new_poly_draw(A As Double, B As Double)
Dim pt As Variant
pt = array(

0   0
B-1.25  0
B-1.0625    0.1875
B 0.1875
B 0.40625
B-.875  0.40625
B-.875  0.34375
B-.0625 0.34375
B-.0625 0.25
B-1.0884    0.25
B-1.2759    0.0625
0.0625  0.0625
0.0625  A-.0625
0.15625 A-.0625
0.15625 A-1
0.21875 A-1
0.21875 A
0   A

Call draw_array(pt)
End Sub

now put commas between values and put your line continuations wherever you want.

Sub new_poly_draw(A As Double, B As Double)
Dim pt As Variant
        
pt = Array(0, 0, B - 1.25, 0, B - 1.0625, 0.1875, _
B, 0.1875, B, 0.40625, B - 0.875, 0.40625, B - 0.875, 0.34375, _
B - 0.0625, 0.34375, B - 0.0625, 0.25, B - 1.0884, 0.25, B - 1.2759, 0.0625, _
0.0625, 0.0625, 0.0625, A - 0.0625, 0.15625, A - 0.0625, 0.15625, A - 1, _
0.21875, A - 1, 0.21875, A, 0, A)
 
 Call draw_array(pt)
End Sub

and you are done, because you have this wrapper to run it

Sub draw_array(pt As Variant)
     Dim pt2() As Double
     Dim objent As AcadLWPolyline
     Dim i As Integer
     Dim lower As Integer, upper As Integer
     lower = LBound(pt)
     upper = UBound(pt)
     
     ReDim pt2(lower To upper)
     For i = lower To upper
     pt2(i) = pt(i)
     Next i
    
     Set objent = acadDoc.ModelSpace.AddLightWeightPolyline(pt2)
         objent.Closed = True
         objent.Update

Set objpersistent = objent

End Sub

objpersistent is a public variable that allows you to move this piece into position in the calling program.

Autocad VBA Parametrics – 1 – Wrapper functions

Sometimes it takes a long time to make something simple. Creating wrapper subroutines makes large parametric programs cleaner and easier to read, allowing them to get larger and more useful. If you straightforwardly code each routine containing all the details it uses, you soon reach a point where the program is too complex looking to modify. Wrapper routines delegate the details of the drawing and make the flow of the calling programs easier to follow.

The ADDLINE method in Autocad VBA requires an array of 3 doubles for each endpoint of the line.

Dim lineobj as AcadLine
Dim pt1(0 To 2) As Double
Dim pt2(0 To 2) As Double
pt1(0) = 2: pt1(1) = 3: pt1(2) = 0
pt2(0) = 40: pt2(1) = 50: pt2(2) = 0
Set lineobj = acadDoc.ModelSpace.AddLine(pt1, pt2)

By contrast the same thing can be done in autolisp with one line of code.

(command “line” (list 2 3) (list 4 5) “”)

Autocad VBA does not allow any shortcuts. Every line drawn has to use a dimensioned named assigned array of 3 doubles.

An Autocad VBA parametric drawing program would quickly require too many points to be practical. Wrapper functions are the solution. I am using the term in an informal way to indicate wrapping a VBA Autocad method to make it easier to use. Here is a simple line wrapper and how it is called.

call line(2, 3, 40, 50)

 Sub line(x1 As Double, y1 As Double, x2 As Double, y2 As Double)
Dim lineobj As AcadLine
Dim pt1(0 To 2) As Double
Dim pt2(0 To 2) As Double
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

Every Autocad VBA object is a candidate for one or more wrappers. The point command in autocad is not used very often in design (its very useful in the graphing calculator), but it could be easily simplified.
Call draw_point(1,3,0)

Sub draw_point(x1 As Double, y1 As Double, z1 As Double)
Dim pointobj As AcadPoint
Dim pt1(0 To 2) As Double
pt1(0) = x1: pt1(1) = y1: pt1(2) = z1
Set pointobj = acadDoc.ModelSpace.AddPoint(pt1)
End Sub

An array of 3 doubles is Autocad VBA’s normal way of specifying a point location used by dozens of different objects. We can make a wrapper to aid making this array. When passing arrays as arguments to a subroutine they are always passed by reference – any changes made to the array in the called program are reflected in the calling program. Unfortunately we cannot get the wrapper to dimension the array for us, but we can simplify the values assignment a little. It does help when a lot of points are being set up.

Dim pt2(0 to 2) as Double
Call initpt(pt2, 2, 4, 0)

Sub initpt(ByRef ptn() As Double, val1 As Double, val2 As Double, val3 As Double)
ptn(0) = val1: ptn(1) = val2: ptn(2) = val3
End Sub

The ADDLIGHTWEIGHTPOLYLINE method requires a single array of doubles, one value for each x and y. A line with two points would require an array with 4 values.

Dim plineobj As AcadLWPolyline
Dim pt(1 To 4) As Double
pt(1) = 2: pt(2) = 3: pt(3) = 40: pt(4) = 50
Set plineobj = acadDoc.ModelSpace.AddLightWeightPolyline(pt)

The LightWeightPolyline method can be wrapped in a box routine. Box is drawn from lower left counterclockwise. The last segment is made with the closed property. In this case a layer is specified. It could be left out of the routine or made optional.
Call mbox(0, 0, L, W, “Hidden”)

Sub mbox(x1 As Double, y1 As Double, x2 As Double, y2 As Double, strlayer As String)
    Dim objent As AcadLWPolyline
    Dim pt(1 To 8) As Double
    pt(1) = x1: pt(2) = y1
    pt(3) = x2: pt(4) = y1
    pt(5) = x2: pt(6) = y2
    pt(7) = x1: pt(8) = y2
    Set objent = acadDoc.ModelSpace.AddLightWeightPolyline(pt)
    objent.Closed = True
    objent.layer = strlayer
End Sub

Rectangular boxes show up a lot in any design. Any plane figure with a known number of vertexes could be hard coded as above. If you have a parametric application that often uses a notched rectangle you would use a polyline wrapper expecting 6 points. Here is how the hardcoded 6 point polyline sub is coded. You can see the 12 inputs are starting to get tedious. This 6 pointed figure has 12 inputs and the 4 pointed figure above has 4 inputs because this figure does not have to have rectangular angles, it simply draws 6 points. the box above is assumed to be square with the coordinate system.

Sub test_p6()
Call connect_acad
Dim L As Double, W As Double, A As Double, B As Double
L = 72
W = 24
A = 12
B = 18
Call p6_box(0, 0, L - B, 0, L - B, A, L, A, L, W, 0, W)
End Sub

Sub p6_box(p1 As Double, p2 As Double, p3 As Double, p4 As Double, p5 As Double, p6 As Double, _
p7 As Double, p8 As Double, p9 As Double, p10 As Double, p11 As Double, p12 As Double)

    Dim objent As AcadLWPolyline
    Dim pt(1 To 12) As Double
    pt(1) = p1: pt(2) = p2
    pt(3) = p3: pt(4) = p4
    pt(5) = p5: pt(6) = p6
    pt(7) = p7: pt(8) = p8
    pt(9) = p9: pt(10) = p10
    pt(11) = p11: pt(12) = p12
    Set objent = acadDoc.ModelSpace.AddLightWeightPolyline(pt)
    objent.Closed = True
End Sub

The straightforward method to draw complex polyline figures would initially be coded all in one sub. The array would be dimensioned then loaded with values and immediately be given to the AddPoly method. This is a closed figure with 16 points.

 Dim objent As AcadLWPolyline
    Dim pt(1 To 32) As Double
    pt(1) = 1: pt(2) = 0.21875
    pt(3) = 0: pt(4) = 0.21875
    pt(5) = 0: pt(6) = 0
    pt(7) = W - 1.25: pt(8) = 0
    pt(9) = W - 1.0625: pt(10) = 0.1875
    pt(11) = W: pt(12) = 0.1875
    pt(13) = W: pt(14) = 0.40625
    pt(15) = W - 0.875: pt(16) = 0.40625
    pt(17) = W - 0.875: pt(18) = 0.34375
    pt(19) = W - 0.0625: pt(20) = 0.34375
    pt(21) = W - 0.0625: pt(22) = 0.25
    pt(23) = W - 1.08839: pt(24) = 0.25
    pt(25) = W - 1.27589: pt(26) = 0.0625
    pt(27) = 0.0625: pt(28) = 0.0625
    pt(29) = 0.0625: pt(30) = 0.15625
    pt(31) = 1: pt(32) = 0.15625
    Set objent = acadDoc.ModelSpace.AddLightWeightPolyline(pt)
    objent.Closed = True

A general method can be devised using a generic wrapper that tests the length of the array passed. However the poly method only accepts an array of doubles, and there is no way to conveniently construct an array of doubles except by declaring the index numbers of each value as above. The array function is easier to construct, but it only works with a variant declared. That is what we will use to construct the point list, then convert it in the wrapper, which can accept an array of any size.

Sub test_draw_array()
    Call connect_acad
    Dim W As Double
    W = 24
    Dim pt As Variant
    pt = Array(1, 0.21875, 0, 0.21875, _
                0, 0, W - 1.25, 0, _
                W - 1.0625, 0.1875, W, 0.1875, _
                W, 0.40625, W - 0.875, 0.40625, _
                W - 0.875, 0.34375, W - 0.0625, 0.34375, _
                W - 0.0625, 0.25, W - 1.08839, 0.25, _
                W - 1.27589, 0.0625, 0.0625, 0.0625, _
                0.0625, 0.15625, 1, 0.15625)
    Call draw_array(pt)
End Sub

Sub draw_array(pt As Variant)
     Dim pt2() As Double
     Dim objent As AcadLWPolyline
     Dim i As Integer
     Dim lower As Integer, upper As Integer
     lower = LBound(pt)
     upper = UBound(pt)
     
     ReDim pt2(lower To upper)
     For i = lower To upper
     pt2(i) = pt(i)
     Next i
    
     Set objent = acadDoc.ModelSpace.AddLightWeightPolyline(pt2)
         objent.Closed = True
         objent.Update
End Sub