How Do I Access Autocad Com Objects From Visual Studio?

I have stopped ignoring visual studio. I am having no issues accessing Com ActiveX objects from VB.Net with nearly the same code that works in VBA. I am not sure what all the naysaying is about. Every thread i have ever seen on running Com objects from Visual Studio says, Don’t do it, It’s a Bad Idea.

It seems to work fine.

as time goes by I may update this, but at this point –

Right click References in Solution Explorer, Add Reference, add the autocad type library.
To get the Autocad namespace to work across all modules, double click My Project in Solution Explorer and add Autocad to Imported Namespaces.

Get a book or study online the differences in syntax. They are pretty minor. The code editor is much improved. Arrays are a little simplified. Indexing is a little different, no static type. There is no variant type, but there is an object type that microsoft uses to read and write arrays to excel spreadsheets. (microsoft has a good one page link to connect to excel com objects HERE) Autodesk has no such single page that i can find, but here are some useful links.

http://help.autodesk.com/view/OARX/2019/ENU/?guid=GUID-BFFF308E-CC10-4C56-A81E-C15FB300EB70

http://help.autodesk.com/view/OARX/2019/FRA/?guid=GUID-C8C65D7A-EC3A-42D8-BF02-4B13C2EA1A4B

http://help.autodesk.com/view/OARX/2019/ENU/?guid=GUID-927E71C2-E515-438E-9D7A-246D97BEF93F

http://help.autodesk.com/view/OARX/2019/ENU/?guid=GUID-D1E1CE43-F42B-4D8E-9B42-FDA9D8CCB6B9

All methods to be capitalized. All arguments in parentheses. No set statements.
Sometimes you have to figure out how to get the namespace shortcuts to work. The error reporting in vs really helps.
The Try, Catch, End Try error system works more cleanly.
Many more tools to use with collections and array types.
There is a stricter approach to datatypes, a setting to relax it, but i have Option Strict On. this is where a book will help. 2012 books are cheap.

So far i have pasted in VBA code, made changes per notes above, and the same objects work with the same logic – lines, polylines, dimensions, blocks, ucs, text, selection sets.

Code below is for version 2018 (“Autocad.Application.22”)

Module Module_Connect_Acad

    Public acadApp As AcadApplication
    Public acaddoc As AcadDocument
    Public acadms As AcadModelSpace

    Public Sub Connect_acad()
        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
    End Sub

End Module

Set Bom_Record = Bom_Records.Add (strPartID)

Understanding the generic VBA Collection object will make almost the entire object model more clear for both Autocad and Excel. Software like autocad and excel are pretty much a collection of collections of objects. The format is plural-singular, such that things-thing, layers-layer, worksheets-worksheet.

All these special collections have a close similarity to the generic VBA collection.

Collection.Add (object, strkey)

You can store (add to collection) elementary data types like integer and string, but objects are most useful. The objects do not have to be the same type, but in most custom extended versions, like worksheet and layer collections, the objects are all the same. The key must be unique. In VBA it cannot look like a number even if its a string. Its optional, but the point is storing and retrieving an object by name. There are two more arguments, before and after, which reference keys already in the collection, but they are not often used.

Collection.Item(indexno or strkey)

Item returns the object. If the index is an integer, it returns the object at that position in the list. If a string is passed it looks for the key. If it fails, it errors out. Item is the default method for Collection, so it can be omitted.

Collection(indexno or strkey)

This is why you usually type Worksheets(”Part”) instead of Worksheets.Item(”Part”). The name of the sheet is the unique key in the collection of Worksheets. Or you could type Worksheets(1) or Worksheets.Item(1)

In VBA an object, in this case a worksheet, is returned, requiring an assignment with the Set keyword,

Set ws = ThisWorkbook.Worksheets.Item(1)

You dont have to create or instantiate the Worksheets, but you do for your own Class objects, and Collections work just like a class.

Dim col As Collection
Set col = New Collection

col.Add ws
MsgBox col.Item(1).Name

Since I didnt use a key with Add, index by number is the only option to retrieve.

Collection.Count returns the total number of items
Collection.Remove(indexno or strkey) removes that member.

Thats it, thats the entire oeuvre of Collection.

Indexing is automatic by the Collection. If an item is removed, the trailing indexes move up. You can specify where in the collection to Add, with Before and After, but once it’s there it’s there.

There is a special Loop feature, custom collections can loop with

For Each object in objects
. . .
Next Object

The other technique is

For inc = 1 to col.count
. . .
Next inc

Collections are like arrays, only one dimensional, and they have a name key for retrieval in addition to index location. How then would we use a Collection to save a table of data? By making a class object for each row.

Lets look at how autocad implements Layers. The Layer Properties Manager is a table. Properties are column headings across the top, layer names are rows in column 1.

To create a new layer,

Dim layer As AcadLayer

Set layer = acaddoc.Layers.Add(“string”)

(acaddoc is my connector from excel which contains the ThisDrawing object)

The Collection class Layers is already created. The collection is available just like Worksheets is available. We are creating a new instance of the Layer object, adding a new row. We use the Add method of collection Layers. What we are passing is the string key, not a created object (like we do in the VBA Collection). The Layers Class is creating the Layer object using the key and adding it to the collection. Its passing back the new Layer object to our variable. It created the layer with all default attributes, so now can set the rest of the attributes.

layer.LineType = “Center”
layer.Color = acRed

This is how a lot of objects are made, from a method in the collection. The bare minimum of attributes are required to create. The object is passed back to set the remaining properties.

In the autocad object model, (hold down CTRL and it will open in a new window)

https://help.autodesk.com/view/OARX/2019/ENU/?guid=GUID-A809CD71-4655-44E2-B674-1FE200B9FE30

As you go down the hierarchy, objects and collections alternate. Rectangles are collections and ovals are objects (see key at bottom). Top level is the application object which contains the Documents collection which contains a Document object. The Document has a pointer to Layers collection. It also has a pointer to another collection ModelSpace which has all the visible objects. Modelspace collection has not one Add method to create objects but about 50 different ones, such as AddLine, AddText, etc. Click on ModelSpace and you will see them. All of them pass back their newly created object for further possible modification of attributes.

Since ModelSpace is a collection, you can iterate through it with the collection style loop.

Dim acad_ent As AcadEntity

For Each acad_ent In acaddoc.ModelSpace
Debug.Print acad_ent.ObjectName
Next acad_ent

Or retrieve with Item

Dim inc As Integer

For inc = 0 To acaddoc.ModelSpace.count – 1
Debug.Print acaddoc.ModelSpace.Item(inc).ObjectName
Next inc

I am not going to try to explain when counts start with 1 and when they start with 0. Its about 50-50. Some programming pioneer must have insisted on 0. Imagine buying a bag of 6 apples from 0 to 5.

Back to our story,

Our BOM goal is to create a BOM sheet, looping through our parts table join. We will have the raw data in an array, and we want one collection object to populate TreeView, ListView and Worksheet. Our parts have potentially both parents and children. I want 3 levels of parts on the DWG BOM indented, from a practical POV, and i want nearly unlimited levels from a programmers POV. Parts have quantities needed for one assembly, and higher total quantities based on assembly quantities. We will make an object class called Bom_Record and a collection class called Bom_Records. If we can duplicate the behavior of the Layers example, we will know our classes are set up correctly.

Set layer = acaddoc.Layers.Add(“string”)

Set Bom_Record = Bom_records.Add(strpart_ID)

A unary table relationship, where the relationship is between instances of a single entity type, parts in our case, is called a recursive relationship. A part cannot be composed of its own self, but it is composed of other parts. To traverse a deeply nested part a recursive program is required. One way to start writing this is to expect only 3 levels, write the code, and watch for where the code starts repeating itself. Write a boolean function called Hasparts(part_id), if it returns true, then pass the current part_id to a sub that makes a list of the sub-parts. The treeview control and the listview control both have a display entry and a key. Assemble this key as a complete path to the part. To populate the treeview the parent always has to be known. I am going to post the code in raw but working form so the project can be taken to a finish. There are still some other features, such as linking the treeview to the listview, writing the listview to a sheet. I am going to finish the project in visual studio, at a later date. First i need to do some smaller projects in vb.net.

    'entry top level uses global var Records
    'g_assy_ID = assy_id
Sub make_col(assy_id As String, assy_qty As Integer)

    're-sets the collection for input
     Set Records = New Bom_Records
 
    Call make_BOM_Records(assy_id, assy_qty)
End Sub

    
Sub make_BOM_Records(assy_id As String, assy_qty As Integer)
    'the global var Records set previous
    'so it can either be new or a continuation
    
    Dim strkey As String
    Dim ar As Variant
    Dim record As bom_record
     
    ar = return_row("PART", assy_id)
    strkey = assy_id & "\"
    
    Set record = Records.Add(strkey)
        
    record.assy_id = assy_id
    record.part_id = ""
    record.subpart_id = ""
    record.qty = assy_qty
    'record.ex_qty =
    record.UM = ar(1, 3)
    record.desc = ar(1, 2)
  
    'no parent - root record
    record.parent_key = ""
    record.mlevel = 1
     
    Debug.Print " "
    Debug.Print "new run"
    Debug.Print strkey
    
        'begin subparts
    If has_parts(assy_id) Then
        Call collect_parts(assy_id, assy_qty, 2, strkey)
    End If
            
End Sub


 'populates global var Records
 'recursive, assy_id is not necessarily top level
Sub collect_parts(assy_id As String, assy_qty As Integer, int_level As Integer, parent_key As String)
        Dim ar As Variant
        Dim part_id As String, strkey As String
        Dim part_qty As Integer, ex_qty As Integer
        Dim part_um As String, part_desc As String
        Dim rows As Integer, r As Integer
        Dim record As bom_record
        
        If int_level > g_max_level Then  'normal max is 3 or 9
        'MsgBox "bom level too high"
        Debug.Print "exit collect parts sub at max_level = " & int_level
        Exit Sub
        End If
                
        'returns 5 col joined table for assy_id\parts
        ar = get_parts(assy_id)
        rows = UBound(ar, 1)
      
        For r = 1 To rows
            'assy_id = ar(r, 1)  true for all rows
            part_id = ar(r, 2)
            part_qty = ar(r, 3)
            part_desc = ar(r, 4)
            part_um = ar(r, 5)
            ex_qty = assy_qty * part_qty 'passed in assy_qty

            'key is simplicity
            strkey = parent_key & part_id & "\"
            Set record = Records.Add(strkey)
          
              'the dwg designer wants an indented excel bom with just 3 levels
              'the programmer wants a 2nd option for nearly unlimited levels
              'there is no subpart id coming in from the array, only parent and child
              'i want bom record to be a finished product, so we need logic here
              'to explicitly save 3 levels as assy, part and subpart
              'when level# is > 3 still use subpart for id ; key is accurate complete path\
              
            record.assy_id = ""
                                     
            If int_level = 2 Then
                       record.part_id = part_id
                       record.subpart_id = ""
                                   
                 Else  '3 or more
                       record.part_id = ""
                       record.subpart_id = part_id
            End If
  
            record.qty = part_qty
            record.ex_qty = ex_qty
            record.UM = part_um
            record.desc = part_desc
            
            record.parent_key = parent_key
            record.mlevel = int_level
      
    Debug.Print strkey
            
            'recursive call, increment level, pass the parent key
            If has_parts(part_id) Then
               Call collect_parts(part_id, ex_qty, int_level + 1, strkey)
            End If
        Next r
End Sub

At this time (this is working but not polished code) I have nothing in the bom_record class except public variables. It could be a structure instead.
in class module Bom_Record

Public assy_id As String
Public part_id As String
Public subpart_id As String
Public qty As Integer
Public ex_qty As Integer
Public UM As String
Public desc As String

Public mlevel As Integer
Public mkey As String
Public parent_key As String

Class Bom_Records though has methods that mimic Add and Item. It has only one private variable, the collection object. The Add method creates a New Bom_Record, just like Layers.Add creates a new layer object. Remove always has issues so it is left out, just like autocad VBA cannot allow Remove without checking every single entity in drawing to see if the object is being referenced.

in Class module Bom_Records

Option Explicit
Private col_records As Collection

Private Sub Class_Initialize()
    Set col_records = New Collection
End Sub

Public Function Add(ByVal strkey As String) As bom_record
    Dim objrecord As New bom_record
    objrecord.mkey = strkey
    col_records.Add objrecord, strkey
     Set Add = objrecord
End Function

Public Function Item(ByVal varID As Variant) As bom_record
    Set Item = col_records.Item(varID)
End Function

Property Get count() As Long
    count = col_records.count
End Property

Property Get col() As Collection
    Set col = col_records
End Property

Some Excel Query Tools for BOM Sheets

Some Query Tools for Excel Sheets

A sheet is a named table. One column has all unique values. We search the column for a particular value and return the row. If the table is called PART, if the primary key column is PART_ID, if the search value is “2020_SD1”, the equivalent SQL would return the row –

SELECT *
FROM Part
WHERE Part_ID=”2020_SD1”;

Maybe missing some table qualifiers or parentheses, but essentially.

In VBA the FIND method of the RANGE object returns a RANGE of the first cell found. The END property of the RANGE will return the row.

https://docs.microsoft.com/en-us/office/vba/api/excel.range(object)

Function find_row(strtable As String, strfind As String) As Range
 'assume column1 is key index unique search column
 'return a single row as range
    Dim ws1 As Worksheet, rng As Range
    Set ws1 = ThisWorkbook.Sheets(strtable)
    Set rng = ws1.Range("A1")
    Set rng = ws1.Range(rng.Address, rng.End(xlDown).Address)
    Set rng = ws1.Range(rng.Address).find(strfind, LookIn:=xlValues, lookat:=xlWhole)
    Set rng = ws1.Range(rng.Address, rng.End(xlToRight).Address)
    Set find_row = rng
    'returns error if not found, cant use .address or .end of nothing
End Function

This returns a range. Anytime we have a range, we can load it into directly into an array. Excel VBA autosizes the array with 2 dimensions, rows and columns, even if there is only 1 row.

This table has 3 columns – the return range has 1 row.

Sub test()
    Dim rng As Range
    Dim strtable As String, strfind As String
    strtable = "PART"
    strfind = "2020_SD1"

    Set rng = find_row(strtable, strfind)
    
    Dim ar As Variant
    ar = rng
    
    MsgBox ar(1, 1) & ar(1, 2) & ar(1, 3)
End Sub

In the BOM project, we need to join two tables. We need to select all rows in COMPONENT that have the Assy_ID we want and join those to the rows in PART where COMPONENT.Comp_ID = PART.Part_ID to get a list of all sub-parts paired with their attributes from both tables.

I am not an SQL expert, but I got two different versions to work in an old copy of MS Access.
The difference is whether the join is called out in the FROM (preferred in new version SQL) or the WHERE clause.

SELECT COMPONENT.Assy_ID, COMPONENT.Comp_ID, COMPONENT.QTY, PART.DESC, PART.UM
FROM PART INNER JOIN COMPONENT ON PART.Part_ID = COMPONENT.Assy_ID
Where COMPONENT.Assy_ID = “string”;

SELECT COMPONENT.Assy_ID, COMPONENT.Comp_ID, COMPONENT.QTY, PART.DESC, PART.UM
FROM PART, COMPONENT
Where COMPONENT.Assy_ID = “string” and COMPONENT.Comp_ID = PART.Part_ID;

In SQL we would do it all in one query, but in VBA the code will be easier to write and read if we do it in steps.

First if we are to present the list of available assemblies, we need distinct values in the COMPONENT.Assy_ID column.

I found this code, modified it to my needs. It returns a zero index single dimension array. We are going to use arrays for the product of any search. Another great feature of an array is that you can load a listbox on a form simply by Listbox1.List= ar.

Function GetUniqueValues() As Variant
    Dim data As Variant
    Dim temp As Variant
    Dim obj As Object
    Dim i As Long
    
    Set obj = CreateObject("scripting.dictionary")
    'gets col A less header
    'you can even sometimes forget you are passing a range to a variant array
    data = return_col("COMPONENT", "A2")
    'excel sizes the array per the range
    'format data(1 to 50, 1 to 1)
        
    For i = 1 To UBound(data, 1)
        obj(data(i, 1) & "") = ""
    Next
    temp = obj.keys
    GetUniqueValues = temp
End Function

function return_column is just like find_row.

 Function return_col(str_sheet As String, str_cell As String) As Range
    Dim ws1 As Worksheet, rng As Range
    Set ws1 = ThisWorkbook.Sheets(str_sheet)
    Set rng = ws1.Range(str_cell)
    Set rng = ws1.Range(rng.Address, rng.End(xlDown).Address)
    Set return_col = rng
End Function

We have a list of unique COMPONENT.Assy_ID. One is chosen. The next step is to return an array of the COMPONENT table filtered for the rows where COMPONENT.Assy_ID = “string”

Here are our table definitions. Part_ID is a unique key. Assy_ID and Comp_ID are a composite key.

PART ( Part_ID, DESC, UM)
COMPONENT ( Assy_ID, Comp_ID, QTY)

We want to SELECT all columns in COMPONENT for a particular Assy_ID and join them to PART where Comp_ID = Part_ID and show the remaining 2 columns from PART. First lets return the filtered Component table for Assy_ID.

There is a bit going on here, but the function still only does one thing. Basically I run the same loop twice, first to find out how many rows there are, to use that number to re-dimension the array, then run the loop again to save the data. It might not be art but it works fine. The first thing done is to return the entire table COMPONENT to an array for searching.

        'returns COMPONENT table as array filtered for rows with assy_id
Function select_component(assy_id As String) As Variant
        'SELECT * FROM COMPONENT
        'WHERE Assy_ID = "string"
    Dim rows As Integer, cols As Integer
    Dim r As Integer
    Dim findnum As Integer
    
        'return entire table to array for searching
        'dim array (1 to rows, 1 to 3 cols)
    Dim arr As Variant
    arr = return_table("COMPONENT")
    rows = UBound(arr, 1)
    cols = UBound(arr, 2)
 
    'search column1 for assy_id string twice
    'first time to redimension array
    For r = 1 To rows
           If arr(r, 1) = assy_id Then
             findnum = findnum + 1
           End If
    Next r
    
    If findnum <> 0 Then
         Dim ar_result As Variant
         ReDim ar_result(1 To findnum, 1 To cols)
        Else
         Exit Function
        End If
    
     findnum = 0 'reset
         'this is structured for a 3 column table, not any table
     For r = 1 To rows
          If arr(r, 1) = assy_id Then
               findnum = findnum + 1
               ar_result(findnum, 1) = arr(r, 1)
               ar_result(findnum, 2) = arr(r, 2)
               ar_result(findnum, 3) = arr(r, 3)
          End If
     Next r
 
    select_component = ar_result
End Function

the function return_table. The conventions are – tables start on A1, the first row is column labels, anytime a continous range is returned, the returned type is range, anytime a non-continuous range is returned, the return type is array.

Function return_table(str_sheet As String) As Range
    'returns entire table to range
    Dim ws1 As Worksheet, rng As Range
    Set ws1 = ThisWorkbook.Sheets(str_sheet)
    Set rng = ws1.Range("A1")
    
    Set rng = rng.CurrentRegion
    Set rng = rng.Offset(1, 0).Resize(rng.rows.Count - 1)
    'takes out the label row
       
    Set return_table = rng
End Function

The next step is to make the join with all rows from component and desc and um from part.

       'returns array COMPONENT joined with PART for Assy_ID sub_parts
       'COMP.ASSY_ID, COMP.COMP_ID, COMP.QTY, PART.DESC, PART.UM
       '1 to rows, 1 to 5 cols
 Function join_comp_part(ar3 As Variant) As Variant
       'passed in table is Component filtered for Assy_ID
     Dim rng As Range
     Dim r As Integer, rows As Integer, cols As Integer
        
     rows = UBound(ar3, 1)
     cols = UBound(ar3, 2) 'we know is 3
   
     Dim ar_result As Variant
        '3 cols from COMP, 2 cols from PART
     ReDim ar_result(1 To rows, 1 To 5)
 
     Dim assy_id As String
     Dim comp_id As String
     Dim comp_qty As Integer
     Dim part_desc As String
     Dim part_um As String
     
     For r = 1 To rows
        assy_id = ar3(r, 1)
        comp_id = ar3(r, 2)
        comp_qty = ar3(r, 3)
         
            'WHERE Component.Comp_ID = Part.Part_ID
            'search PART table column1 for part_id, return row as range
        Set rng = find_row("PART", comp_id)
        part_um = rng.Cells(1, 3).Value
        part_desc = rng.Cells(1, 2).Value
         
            ar_result(r, 1) = assy_id
            ar_result(r, 2) = comp_id
            ar_result(r, 3) = comp_qty
            ar_result(r, 4) = part_desc
            ar_result(r, 5) = part_um
     Next r

    join_comp_part = ar_result
End Function

That brings us to a stopping point, because up til now, if you accept the basic table relation as a workable BOM structure, we have simply joined the tables. From here on though, everyone has different needs, and will want to write the next manipulation according to their on-dwg bom style, or formatted to paste into their ERP structure.

So lets recap.

We have two tables. One table is the main PART table. Its a list of every PART identification number in the system. For the excel version, its of course a subset. It has 3 columns, part number, description and unit of measure. In the real world, especially if the intent is to interface directly to ERP, there would be some additional foreign key columns to purchase, track cost, show inventory etc. It has no information about the part using or being used by assemblies.

The second table is the assembly information table I called COMPONENT. It has a double key, the assembly number and the component number, parent and child, the part and sub-part. Neither of these numbers is unique singly in this table but is unique taken together. Both numbers are found in the PART table. I could have called the table ASSEMBLY. A third column has the quantity needed for the assembly.

Pic here

The first main function select_component searches COMPONENT for an Assy_ID and returns the table just for those parts.

Pic here

The second function join_comp_part joins the two tables

Pic here

Thats where we are at. Some subs are called but not shown. I am re-writing code as i go, having the first prototype working, making some fairly major revisions hopefully to make the code simpler, less chunky, more modular. its not finished code that has been in production. it is subject to change. You might notice there is no error checking. My goal is to figure out how i want it to work, includng a form interface, then break it with bad data and add error checking. The next step makes the actual dwg bom with an assembly quantity, extended quantities for sub-parts and loops thru the list looking for sub-parts to the sub-parts. I will show my version of an indented bill of material.

The Fundamental Bill of Material Relation

From the designer’s point of view, the Bill of Material turns a sketch into a construction document. Its hard to generalize about BOMs, because of the variability of use. A BOM for a mass produced product is not like one for engineer-to-order/make-to-order. A BOM for a product small enough to be made and shipped in a box is not like one loaded in pieces and assembled on-site. A BOM might be an instruction for an experienced shop to build, or for an in-experienced customer to assemble. It might be a list of spare parts for replacement when the originals wear out. It might be a sales tool meant to inspire confidence – the design approved by the customer before the sale is made. The main customer of the drawing might be the designer who has a problem and uses the drawing to work it out. Next year he will have a similar problem and this drawing will be his prime source. it has to be complete and make sense. The BOM names and identifies the end product and the parts to get there.

Whatever the purpose and appearance of the drawing level BOM, however it is constructed, it is a report. It’s a view of the data in a Parts database. The view can change. The PART table it is based on all have similar features.

A formal database table, whether its in MS Access or your half million dollar ERP, is a collection of related entities. The items in a table are related by being all of one kind. A second kind of relation is the relationship between tables. Every table is named. The columns in a table are named. The rows are not named. There is a fixed number of columns, after the table design is complete, but a variable number of rows. Each row is a record. Every table has one column where the values are unique, no duplicates, no blanks, called the primary key. It provides the key to the record. Another column usually has the foreign key. It has the same kind of data as the primary key, but duplicates are allowed. Matching the primary key from one table and the foreign key of a second table is how tables are related.

Manufactured products are composed of assemblies, which are composed of sub-assemblies and parts. Every tracked item has to have a unique identifying number or name. These all go into one PARTS table. Assys, Sub-Assys, Made Parts and Purchased Parts are all distinct line items in the same PART table. One Assy can use many Parts, and one Part can be used in many Assys. That is called a Many to Many relationship. There is no limit in theory how many levels of Sub-Assys can be used in other Sub-Assys. This cannot be modeled in a single table.

The purpose of formal database structure is to make the storage and retrieval of data efficient, to eliminate duplication of data. The most common relation is between two tables of two different kind of things. When items of the same type in a single table have a relationship between themselves – called a Unary relationship – and it is a many-to-many type, a second table has to be created.

Modeling a relational dabase in Excel for output to Autocad – you can think of this as a pilot project, or a demonstration, or an educational project, but i think its a little bit more. Excel is the BOM autocad has always needed. Its a natural fit. Autocad never had a BOM solution and only introduced tables 2008 (or so). The designer creates the BOM, whether he does it in the window of the ERP program, or Excel, or with pencil and paper. Even if you hire Bill Gates to do your website, at some point he is going to ask you, where is your content? The ERP is the same way. You won’t get to standard parts if you implement with no knowledge of how a parts table works with no part naming conventions at all. Accounting may be satisfied, but engineering is just feeding the ERP beast and gaining nothing from it. With a mock up at least, you have to start thinking about how to name parts so it works over time. Excel can be used to paste into autocad and paste into ERP, so its not quite the same thing as duplicating data. It’s the most convenient editor. It has possible application for designing standard products, which are hard to do in an engineer to order company.

Here is the basic model of the Bill of Material relation – how you capture Assemblies of Sub-assemblies of Parts using database concepts. I will start doing the supporting code in the next post.

I had to make a decision about my on-dwg bom. Remember its just a report and is a view of the data. I chose 3 levels with 3 columns. I called them Assy_ID, Part_ID and LVL3. The part number is in the appropriate column. Thats my version of an indented bill. Google “Indented Bill of Material” for other ideas. So i do not have an infinite recursion of parts here. You could do that, but it would require a LEVEL column with an integer. Those dont seem particularly easy to read. As a first attempt, this works.

I have to credit my text. The E-R diagram and table structure (and probably some of the verbiage) are from
Modern Database Management, Hoffer, Prescott, McFadden, Prentice Hall, Sixth Ed, 2002

Equations of Lines in Space

In 2D coordinates, AX + BY + C = 0 is the equation of a line. In 3D coordinates, this equation represents a plane. In 3D coordinates its not possible to specify a line by a single equation. A 3D line is represented by 3 equations, one for each x,y and z.

A straight line in space is completely determined by two points. It is also completely determined with a single point and a set of direction numbers. The direction numbers are the difference of the coordinates over any segment. Direction numbers come in sets of three. Its the same idea as a vector. A line has an infinite amount of direction number sets, all of them proportional. Just as you can multiply a vector by a scalar, and obtain another vector parallel but with a different length, you can multiply direction numbers by a scalar, call it t, and obtain further points on the same line.

If two points are given, (x1,y1,z1) and (x2,y2,z2), direction numbers are (x2-x1, y2-y1, z2-z1). These are often referred to as (a,b,c).

Either point can be used for the given point

X = x1 + at
Y = y1 + bt
Z = z1 + ct

To create an unending line in both directions, t takes on values between negative and positive infinity.

if we take an example, let one point P1 be the origin and the other point be (2,3,4). use P1 for the given point and (2,3,4) for (a,b,c)

X = 2t
Y = 3t
Z = 4t

the length of a line segment is the sq root of the sum of the coordinate deltas squared, so Len (2,3,4) is 29^1/2

when t = 0, the point on the line is the origin. When t=1, the point is (2,3,4).

when

so if

when the line segment is 1, the coordinates are the direction cosines. the angle between the line and each of the coordinate axes can be found by taking the ArcCosine.

to put an arrowhead on a 3D vector, i insert an arrowhead block. I wanted to draw and do a revolve, but i was not initially able to find the activex method for revolve, so insert a block is the standby. i drew the cone shape the same size as dimension arrowheads so the scale factor works in a similar way. the insertion point is the head of the vector. we need the angle. i pass a direction vector, which is a parallel vector any length. normally i will just pass the same vector, but sometimes like when constructing an XYZ axes it is just as convenient to pass a unit vector.

Sub arr(pt1() As Double, D() As Double)
‘3D arrow
‘pt1 is location of the arrow
‘D is direction vector

the direction cosines of the direction vector are the familiar array of 3 doubles.

Dim dir_cos() As Double ‘direction cosines
dir_cos = ret_3D_angle(D)

the function ret_3D_angle takes one parameter, the direction vector, calculates the length, divides the x,y,z values by the length, and returns all 3 together in an array, just like a point.

the direction cosine for the x axis – the x coordinate for the direction vector at the place where the length is one – is used and the angle found for autocad to use later.

Dim alpha As Double
alpha = WorksheetFunction.Acos(dir_cos(0))

we have not passed in the actual tail coordinate of the vector we are trying to arrow. we have passed in the head coordinate and a vector parallel. the direction vector is positionless. its just 3 numbers. if we subtract those from the head coordinates, we will have a second point on the vector.

when we do that we have enough coordinates to change the user coordinate system, ucs in autocad, to a plane defined by the two lines, the vector itself and a line from the tail point just calculated parallel to the x-axis.

First we insert the arrowhead at rotation zero at the world coordinate system. then change the user coordinate system to the one defined by our vector and a line parallel to the x-axis. when you rotate an object, it rotates around a line perpendicular to the user coordinate system. so in effect by changing the user coordinate system, we have already made one rotation, even though we have not applied it yet. now rotate the arrowhead by the insertion point through alpha radians that we previously calculated. that completes the 3D arrow rotation.

Even though there are 3 angles from a vector to each of the axes, any two of them determine the third.

here is a diagram i did a while back on the arrowhead rotation problem.

x1,y1, z1 is any valid point on the vector which we have found above. to create a new ucs, a new origin is located, then a point on the new x-axis, and a point on the new y-axis. they must form a right angle. the new origin can be assembled from the head and tail coordinates. the new x-axis point can just add one value for x, and the new y-axis can use the head coordinates. some special error checking has to occur when the arrow is on the x-axis.

Sub arr(pt1() As Double, D() As Double)
'3D arrow
'pt1 is location of the arrow
'D is direction vector
    Dim x1 As Double, y1 As Double, z1 As Double
    Dim x2 As Double, y2 As Double, z2 As Double
    Dim origin() As Double, xAxis() As Double, yAxis() As Double
        
    Dim dir_cos() As Double  'direction cosines
    dir_cos = ret_3D_angle(D)
    
    Dim alpha As Double
    alpha = WorksheetFunction.Acos(dir_cos(0))
    
   Dim blkref As AcadBlockReference
   Dim blkname As String
   blkname = "Ar_Head3D"
   If sc = 0 Then sc = 1
       
   'need an illustration
   'pt1 is the location for the arrowhead
   'D is the direction vector
   'the new origin is x from pt1 and y and z calculated from tail of D
   
   'transfer pt1 to x2,y2,z2
   x2 = pt1(0)
   y2 = pt1(1)
   z2 = pt1(2)
   
   ' direction vector is positionless
   ' so we in effect put it at head and find tail
   x1 = x2 - D(0)
   y1 = y2 - D(1)
   z1 = z2 - D(2)
   
   ' the new origin and new xaxis can be calculated
   ' the new yaxis is the tip of the arrow
   origin = pt(x2, y1, z1)
   xAxis = pt(x2 + 1, y1, z1)
   yAxis = pt1
   set_wcs  ' make sure we insert at world ucs


   Set blkref = acadDoc.ModelSpace.InsertBlock(pt1, blkname, sc, sc, sc, 0)
   
   'error when d(1) = 0 ucs yaxis is same as origin
   'when alpha = 0 dont need to rotate
   'when alpha = pi dont need to change ucs
   'On Error Resume Next
   
   If dir_cos(0) = 1 Then Exit Sub
      
   If dir_cos(0) <> -1 Then
        Call set_ucs(origin, xAxis, yAxis, "UCS_alpha")
        End If
         
        blkref.Rotate pt1, alpha
        set_wcs
 
End Sub


Function ret_3D_angle(D() As Double) As Double()
'D is direction vector
'returns an array of 3 doubles that contain the direction cosines
Dim vector_len As Double
Dim pt1() As Double
Dim A As Double, B As Double, C As Double

vector_len = leng(D)

If vector_len = 0 Then
MsgBox "zero vector in ret_3D_angle"
Exit Function
End If

A = D(0) / vector_len
B = D(1) / vector_len
C = D(2) / vector_len

pt1 = pt(A, B, C)
ret_3D_angle = pt1

End Function


Sub set_ucs(origin() As Double, xAxis() As Double, yAxis() As Double, strName As String)
    Dim ucsObj As AcadUCS
    
    Set ucsObj = acadDoc.UserCoordinateSystems.Add(origin, xAxis, yAxis, strName)
    acadDoc.ActiveUCS = ucsObj
 End Sub
 
 
    Sub set_wcs()
     ' Call Connect_Acad
    
    Dim ucsObj As AcadUCS
    Dim pt0() As Double, ptx() As Double, pty() As Double
 
    pt0 = pt(0, 0, 0)
    ptx = pt(1, 0, 0)
    pty = pt(0, 1, 0)

   Set ucsObj = acadDoc.UserCoordinateSystems.Add(pt0, ptx, pty, "World")
   acadDoc.ActiveUCS = ucsObj
 End Sub

Planes

Autocad has a point, a line, but no plane object. The Region object works fine.

AddRegion takes an array of autocad entities which must be a closed figure. This would make a triangle.

Sub plane_3pt(pt1() As Double, pt2() As Double, pt3() As Double)
 Dim lines(0 To 2) As AcadEntity

 Set lines(0) = line1(pt1, pt2)
 Set lines(1) = line1(pt2, pt3)
 Set lines(2) = line1(pt3, pt1)

 Dim regionobj As Variant
 regionobj = acadDoc.ModelSpace.AddRegion(lines)
 regionobj(0).EntityTransparency = 90

End Sub

in this sub to make a region from 4 pts i added an optional layer argument and a global variable to control transparency. To view a region you have to change the autocad visual style to anything except 2D Wireframe.

Sub plane_4pt(pt1() As Double, pt2() As Double, pt3() As Double, pt4() As Double, Optional strlayer As Variant)
 Dim lines(0 To 3) As AcadEntity

 Set lines(0) = line1(pt1, pt2)
 Set lines(1) = line1(pt2, pt3)
 Set lines(2) = line1(pt3, pt4)
 Set lines(3) = line1(pt4, pt1)

 Dim regionobj As Variant
 regionobj = acadDoc.ModelSpace.AddRegion(lines)
 regionobj(0).EntityTransparency = g_transparency

    If Not IsMissing(strlayer) Then
       regionobj(0).Layer = strlayer
    End If

End Sub

you can pass a polyline. it has to be a 3D polyline. if you do that, the array only needs one slot. You cannot pass the polyline directly to AddRegion

Sub plane_pl(pline As Acad3DPolyline, Optional strlayer As Variant)

Dim lines(0) As AcadEntity
Set lines(0) = pline

Dim regionobj As Variant
regionobj = acadDoc.ModelSpace.AddRegion(lines)
regionobj(0).EntityTransparency = g_transparency

    If Not IsMissing(strlayer) Then
       regionobj(0).Layer = strlayer
    End If

End Sub

a simple equation such as x=3 is a line in 2D space, but its a plane in 3D space.

this is the test code to create planes setting x = 1,2,3,4,5,6,7,8,9 and setting a layer with the same name and color.

init sets up the min and max for y and Z . I shouldnt run a loop counter with a double, but it didnt cause any trouble. my pt sub that creates point arrays expects a double.

Sub test_plane5()
  init
  Dim x As Double

    For x = 1 To 9
        pt1 = pt(x, ymin, zmin)
        pt2 = pt(x, ymax, zmin)
        pt3 = pt(x, ymax, zmax)
        pt4 = pt(x, ymin, zmax)
        
        plane_4pt pt1, pt2, pt3, pt4, x
    Next x
  Update
End Sub

to make 3D polylines to use in region making, i use an old sub i use for drawing 2D profiles, modified for 3D. its a little more complicated looking, but the purpose of it is to be able to make the point array with the VBA ARRAY statement. unfortunately autocad VBA Add3DPoly does not accept this array so it has to be copied to an array of doubles.

pts = Array(x, y1, z1, x, y1, z2, x, y2, z2, x, y2, z1)

this can be any number of points, the receiving sub counts the index numbers and sets up a for loop to copy.

here are 3 subs to draw planes parallel to the coordinate planes using this method.

Sub test_plane8()
  init
  
  xplane 2, "1"
  yplane 1, "2"
  zplane -2, "3"

  Update
End Sub


Sub xplane(x As Double, strlayer As String)
  Dim y1 As Double, y2 As Double
  Dim z1 As Double, z2 As Double
  Dim pts As Variant
    
  y1 = ymin: y2 = ymax
  z1 = zmin: z2 = zmax

      pts = Array(x, y1, z1, x, y1, z2, x, y2, z2, x, y2, z1)
      Call draw_3D_array(pts)
      plane_pl g_3D_pline, strlayer
End Sub

Sub yplane(y As Double, strlayer As String)
  Dim x1 As Double, x2 As Double
  Dim z1 As Double, z2 As Double
  Dim pts As Variant
    
  x1 = xmin: x2 = xmax
  z1 = zmin: z2 = zmax

      pts = Array(x1, y, z1, x1, y, z2, x2, y, z2, x2, y, z1)
      Call draw_3D_array(pts)
      plane_pl g_3D_pline, strlayer
End Sub

Sub zplane(z As Double, strlayer As String)
  Dim x1 As Double, x2 As Double
  Dim y1 As Double, y2 As Double
  Dim pts As Variant
    
  x1 = xmin: x2 = xmax
  y1 = zmin: y2 = zmax

      pts = Array(x1, y1, z, x1, y2, z, x2, y2, z, x2, y1, z)
      Call draw_3D_array(pts)
      plane_pl g_3D_pline, strlayer
End Sub


Sub draw_3D_array(ar As Variant)
     Dim pts() As Double
     Dim i As Integer
     Dim lower As Integer, upper As Integer
     lower = LBound(ar)
     upper = UBound(ar)
     
     ReDim pts(lower To upper)
     For i = lower To upper
     pts(i) = ar(i)
     Next i
         
         Set g_3D_pline = acadDoc.ModelSpace.Add3DPoly(pts)
         g_3D_pline.Closed = True
         g_3D_pline.Update
End Sub

Sub plane_pl(pline As Acad3DPolyline, Optional strlayer As Variant)
 Dim lines(0) As AcadEntity
 Set lines(0) = pline

 Dim regionobj As Variant
 regionobj = acadDoc.ModelSpace.AddRegion(lines)
 regionobj(0).EntityTransparency = g_transparency

    If Not IsMissing(strlayer) Then
       regionobj(0).Layer = strlayer
    End If
End Sub

in 2D space, the standard equation of a line is

Ax + By + D = 0

in 3D space, this is a plane.

the standard equation of a plane in 3D space is

Ax + By + Cz + D = 0

if C is zero, the plane is parallel to the Z axis.

the equation can be rewritten to

Y = -A/B * X – D/B

Sub test_plane9()
  init

  xyplane -4, 2, 2, "4"
  xyplane 3, 2, -2, "5"
      
  Update
End Sub


Sub xyplane(A As Double, B As Double, D As Double, strlayer As String)
  Dim x1 As Double, x2 As Double
  Dim y1 As Double, y2 As Double
  Dim z1 As Double, z2 As Double
  Dim pts As Variant
    
  z1 = zmin: z2 = zmax
  x1 = xmin: x2 = xmax

  y1 = -A / B * x1 - (D / B)
  y2 = -A / B * x2 - (D / B)

      pts = Array(x1, y1, z1, x2, y2, z1, x2, y2, z2, x1, y1, z2)
      Call draw_3D_array(pts)
      plane_pl g_3D_pline, strlayer
End Sub

if you are not seeing transparency, there is a variable that disables it.

set TRANSPARENCYDISPLAY to 1

another variable DELOBJ deletes the defining lines when the Region is made. it works if the Region is made manually, but does not seem to work when the Region is made in code.

remember, set Visual Style not to 2D wireframe

A little Problem with Arrowheads

we will get to that later.

Plotting a plane

Ax + By + Cz + D = 0

difficult to see in a single view.
using arbitrary values, A=2 B=3 C=4 D=5

a plane is defined by 3 points, but the equation for a plane is derived from a single point and the direction numbers for a 3D line that is perpendicular to the plane. so given the equation for a plane, find at least 3 points in the plane.

we can set any 2 of the 3 variables xyz to zero and solve for the third to get 3 points where the plane intercepts the axes.

(-D/A, 0, 0)
(0, -D/B, 0)
(0, 0, -D/C)

we can set one variable to zero and solve to get an equation for a 2D line in the coordinate axis plane, then choose reasonable numbers for the minimum and maximum of the dependent variable.

Vectors and Geometry

exercises from “Linear Algebra”, David Poole, 2006, Thomson

To find a number half-way between two numbers, add them then divide by two. Similarly, to find a midpoint of a line add the coordinates of the endpoints and divide by two.

Since a vector and a point have the same data structure, to find a vector half way between two other vectors, it has a different notation, but it breaks down to the same calculation.

We use the standard notation to show points as Capitals. Vectors to those points are lower case. VBA vector variables are lower case. VBA points will be as ptA, ptB etc, although since Points and Vectors in VBA have identical data structures we dont need to double declare. Vectors are mobile. The algebra of vectors does not depend on position. To draw them in autocad, a start position is specified.

Given two vectors a and b, the vector from a to b is b-a. This is practically the definition of a vector. In autocad a line has a startpoint and endpoint. The vector represented by that line is the difference from start to finish. The line can be moved or copied, and as long as it is not rotated or stretched, it represents the same vector. The total difference of the coordinates is the vector. Autocad Lines have properties of DeltaX, DeltaY and DeltaZ. These do not change when the line is copied and moved. They are the vector.

If we take a line with endpoints A and B, the vectors from the origin to those points are a and b. If we define a vector from the origin to the midpoint of the line as m, then the vector from a to m is m-a. m-a is already defined as 1/2 (b-a), so we have an equation that we can simplify to get the result – given two points A and B, the vector to the midpoint is m = 1/2 (a + b).

In this diagram a parallelogram diagonal shows the result of adding two vectors. When they are subtracted the result is represented by the diagonal between them. The diagonals bisect each other, so that in this case half of the long diagonal, 1/2 (a + b) is equal to m.

To find a point a third of the way between two points, or in general any fraction, requires to go back to the original equation.

Vector algebra can be used to prove and illustrate geometry.

A line from the midpoints of two sides of a triangle is half the length and parallel to the other side. Here we use the vector midpoint formula to find the midpoints of sides of a triangle, then subtract those vectors from each other to find a vector equation for the line joining them, then simplify that equation to see that it is exactly one half the length of the other side. The figure is drawn in vba and the same calculation made to verify the result.

An arbitrary quadrilateral which has its midpoints joined forms a parallelogram. The vectors on opposite sides are compared in VBA to see if they have identical values.

doing the calculation g = 1/3 (a + b + c) also draws a vector to the centroid G.

I had trouble with this one. The altitude of a triangle is a line from a vertex perpendicular to the other side. The 3 altitudes intersect at a point called the orthocenter. Prove this by finding the intersection of two altitudes and show the third one goes thru the point and is perpendicular to the third side. I could not figure out how to get vector h. I could use actual data to prove it for this one specific case, but not a general vector equation. i believe solution lies with the similarity of triangles – the projection of AB on BC at P is the same as the projection of BH on BC at P, so that AB dot BC is equal to BH dot BC. and the same argument for AB on AC. In lieu of that, i show the drawing of the figure in autocad VBA.

The triangle vertexes are given. The altitude starts at a vertex. It terminates at a right angle to the other side, which has known endpoints and hence a known slope. The slope of the altitude is the negative inverse of the slope of the line it meets. Autocad has a method to determine an intersection between two drawing objects, called InterSectWith. I use it twice, once to find the orthocenter intersection of altitudes point H, then to find the intersection with the far side.

First the line is drawn from the vertex using the slope and an arbitrary length. That establishes actual autocad entities to use with the InterSectWith method. I draw all lines with a function that returns a line object, and once the proper endpoint is found, its easy to change the endpoint property of the line.

slope = tan theta = delta y / delta x

Slope and tangent work with undirected lines. On the graph, its the angle the line makes with the positive x axis from -90 to +90. Given the slope as a simple number, we have lost the ability to know what quadrant the coordinates were in. If you wanted to draw vectors, you would have to analyze the x and y values independently. I dont worry about that here. If the line is drawn the wrong way, I change the length of its sign. The bottom line is that slope and tangent work with the same set of angles, and to find the angle from the slope, use the arctangent function ATN.

theta = ATN (slope)

See the function for line3 which accepts a startpoint, a slope and a length to draw a line.

code after the picture

Sub test7()
'5 p30 altitude of triangle from vertex to perpendicular
   init
   'orthocenter
   Dim ptH() As Double
   'lines
   Dim AB As AcadLine, BC As AcadLine, CA As AcadLine
   Dim AP As AcadLine, BQ As AcadLine, CR As AcadLine
   'slopes
   Dim m_AB As Double, m_BC As Double, m_CA As Double
   'points
   Dim ptA() As Double, ptB() As Double, ptC() As Double
   Dim ptP() As Double, ptQ() As Double, ptR() As Double
          
   ptA = pt(2, 1, 0)
   ptB = pt(9, 3, 0)
   ptC = pt(3, 6, 0)
   
   Set AB = line1(ptA, ptB)
   Set BC = line1(ptB, ptC)
   Set CA = line1(ptC, ptA)
   
   m_AB = slope(ptA, ptB)
   m_BC = slope(ptB, ptC)
   m_CA = slope(ptC, ptA)
      
   Set AP = line3(ptA, (-1 / m_BC), 5)
   Set BQ = line3(ptB, (-1 / m_CA), -5)
   Set CR = line3(ptC, (-1 / m_AB), -5)
       
   ptH = intersectWith(AP, BQ)
    
    AP.EndPoint = ptH
    BQ.EndPoint = ptH
    CR.EndPoint = ptH
        
   ' txt1 "A", ptA, 0.375
   ' txt1 "B", ptB, 0.375
   ' txt1 "C", ptC, 0.375
   ' txt1 "H", ptH, 0.375
    
    ptP = intersectWith(AP, BC)
    ptQ = intersectWith(BQ, CA)
    ptR = intersectWith(CR, AB)
         
    AP.EndPoint = ptP
    BQ.EndPoint = ptQ
    CR.EndPoint = ptR
       
   Update
End Sub

Function line1(startpt() As Double, endpt() As Double, Optional strlayer As Variant) As AcadLine
    Set line1 = acadDoc.ModelSpace.AddLine(startpt, endpt)
        
    If Not IsMissing(strlayer) Then
       line1.Layer = strlayer
    End If
         
    g_pt = endpt
  End Function

  Function line3(pt1() As Double, slope As Double, leng As Double) As AcadLine
    Dim pt2() As Double, theta As Double
     theta = Atn(slope)
    
     pt2 = acadDoc.Utility.PolarPoint(pt1, theta, leng)
     Set line3 = acadDoc.ModelSpace.AddLine(pt1, pt2)
    
     g_pt = pt2
  End Function

Function slope(pt1() As Double, pt2() As Double) As Double
     Dim x As Double, y As Double, z As Double
     y = pt2(1) - pt1(1)
     x = pt2(0) - pt1(0)
    
    If x = 0 Then
    MsgBox "div by zero in slope"
    Exit Function
    Else
    slope = y / x
    End If

End Function

  Function intersectWith(L1 As AcadLine, L2 As AcadLine) As Double()
    Dim ptH(0 To 2) As Double
    Dim intpoints As Variant
    
    intpoints = L1.intersectWith(L2, acExtendBoth)
   
    ' copied changed from autocad activex help for Intersectwith
    Dim I As Integer, j As Integer
     
    If VarType(intpoints) <> vbEmpty Then
        For I = LBound(intpoints) To UBound(intpoints)
             
            ptH(0) = intpoints(j)
            ptH(1) = intpoints(j + 1)
            ptH(2) = intpoints(j + 2)
                        
            I = I + 2
            j = j + 3
        Next
     Else
        MsgBox "did not find intersect"
     End If

    intersectWith = ptH

End Function

Prove the perpendicular bisectors of a triangle are concurrent. The point K is called the circumcenter. A circle with center at K passes through the vertexes.

code to draw (not prove) after the picture

Sub test8()
'6 p30 perpendicular bisector of 3 sides of triangle are concurrent
  init
   
   'circumcenter
   Dim ptK() As Double
   'lines
   Dim AB As AcadLine, BC As AcadLine, CA As AcadLine
   Dim PK As AcadLine, QK As AcadLine, RK As AcadLine
   'slopes
   Dim m_AB As Double, m_BC As Double, m_CA As Double
   'points
   Dim ptA() As Double, ptB() As Double, ptC() As Double
   Dim ptP() As Double, ptQ() As Double, ptR() As Double

   ptA = pt(2, 1, 0)
   ptB = pt(9, 3, 0)
   ptC = pt(3, 6, 0)
   
   Set AB = line1(ptA, ptB)
   Set BC = line1(ptB, ptC)
   Set CA = line1(ptC, ptA)
   
   m_AB = slope(ptA, ptB)
   m_BC = slope(ptB, ptC)
   m_CA = slope(ptC, ptA)
   
   ptP = midpoint(ptB, ptC)
   ptQ = midpoint(ptC, ptA)
   ptR = midpoint(ptA, ptB)
      
   Set PK = line3(ptP, (-1 / m_BC), 5)
   Set QK = line3(ptQ, (-1 / m_CA), -5)
   Set RK = line3(ptR, (-1 / m_AB), -5)

   ptK = intersectWith(PK, QK)
    PK.EndPoint = ptK
    QK.EndPoint = ptK
    RK.EndPoint = ptK

   Update
End Sub

finally, another unfinished project, prove the lines joining the midpoints of a quadrilateral bisect each other.

Sub test10()
'8 p30 lines joining midpoints of opposite sides of a quadrilateral bisect each other
  init
   
   Dim ptZ() As Double
   'lines
   Dim AB As AcadLine, BC As AcadLine, CD As AcadLine, DA As AcadLine
   Dim PR As AcadLine, QS As AcadLine
   
   Dim ptA() As Double, ptB() As Double, ptC() As Double, ptD() As Double
   Dim ptP() As Double, ptQ() As Double, ptR() As Double, ptS() As Double
   
   ptA = pt(2, 8, 0)
   ptB = pt(10, 7, 0)
   ptC = pt(12, 2, 0)
   ptD = pt(1, 3, 0)
   
   Set AB = line1(ptA, ptB)
   Set BC = line1(ptB, ptC)
   Set CD = line1(ptC, ptD)
   Set DA = line1(ptD, ptA)
    
   ptP = midpoint(ptA, ptB)
   ptQ = midpoint(ptB, ptC)
   ptR = midpoint(ptC, ptD)
   ptS = midpoint(ptD, ptA)
   
   Set PR = line1(ptP, ptR)
   Set QS = line1(ptQ, ptS)
    
    txt1 "A", ptA, 0.375
    txt1 "B", ptB, 0.375
    txt1 "C", ptC, 0.375
    txt1 "D", ptD, 0.375
   
    txt1 "P", ptP, 0.375
    txt1 "Q", ptQ, 0.375
    txt1 "R", ptR, 0.375
    txt1 "S", ptS, 0.375
    
    ptZ = intersectWith(PR, QS)
    txt1 "Z", ptZ, 0.375
 
   Update
End Sub

Vectors 3

This is my third try at vectors. It starts with basic vector algebra.

A vector is an ordered triple of numbers, representing the xyz coordinates of the head, the tail at 0,0,0. A vector and a point have the same structure, an array of 3 doubles. Vector algebra functions accept a vector as input and return the calculated vector. Position comes into play when we want to display the vector in autocad. (these are NOT all debugged on first draft)

Here are the elementary vector functions.
Plus (U,V) returns vector U + V
Minus (U,V) returns vector U – V
Scalar(c, U) returns vector c * U
Dot(U, V) returns double dot product
Leng(U) returns double length of vector
UnitV(U) returns unit vector along U
Dist(U, V) returns double distance between vectors
Angle(U, V) returns angle between vectors as double in radians
Ortho(U, V) returns boolean True if vectors are perpendicular
Proj(U, V) returns vector V projected on U
Neg(U) returns negative vector

Draw(vec) Draws vector in autocad as simple line

the function to create a point takes the triples input and returns the array of 3 doubles.

dim pt1() as double
pt1 = PT(1,2,3)

this is used as the basic vector creation function.

dim u() as double
u= VEC(1,2,3)

Function vec(x As Double, y As Double, z As Double) As Double()
    Dim pnt(0 To 2) As Double
    pnt(0) = x: pnt(1) = y: pnt(2) = z
    vec = pnt
End Function

Function plus(u() As Double, v() As Double) As Double()
    Dim w(0 To 2) As Double
    w(0) = u(0) + v(0)
    w(1) = u(1) + v(1)
    w(2) = u(2) + v(2)
    
    plus = w
End Function

Function scalar(c As Double, u() As Double) As Double()
    Dim w(0 To 2) As Double
    w(0) = c * u(0)
    w(1) = c * u(1)
    w(2) = c * u(2)
    
    scalar = w
End Function

Function minus(u() As Double, v() As Double) As Double()
    Dim w(0 To 2) As Double
    w(0) = u(0) - v(0)
    w(1) = u(1) - v(1)
    w(2) = u(2) - v(2)
    
    minus = w
End Function

Function dot(u() As Double, v() As Double) As Double
    Dim w As Double
    w = u(0) * v(0) + u(1) * v(1) + u(2) * v(2)
    dot = w
End Function

Function leng(u() As Double) As Double
    Dim w As Double
    w = u(0) ^ 2 + u(1) ^ 2 + u(2) ^ 2
    w = Sqr(w)
        
    leng = w
End Function

Function unitv(u() As Double) As Double()
    Dim w() As Double
    Dim L As Double
    
    L = leng(u)
    w = scalar(1 / L, u)

    unitv = w
End Function

Function dist(u() As Double, v() As Double) As Double
    Dim L As Double
    L = leng(minus(u, v))
    
    dist = L
End Function

Function angle(u() As Double, v() As Double) As Double
    Dim Dot_UV As Double
    Dim len_U As Double
    Dim len_V As Double
    Dim cos_theta As Double
 
    Dot_UV = dot(u, v)
    len_U = leng(u)
    len_V = leng(v)
    
    cos_theta = Dot_UV / (len_U * len_V)
    
    angle = WorksheetFunction.Acos(cos_theta)
End Function

Function ortho(u() As Double, v() As Double) As Boolean
    Dim w As Double
    w = dot(u, v)
    
    If w = 0 Then
    ortho = True
    Else
    ortho = False
    End If
End Function

Function proj(u() As Double, v() As Double) As Double()
    Dim w() As Double
    Dim x As Double
    Dim Dot_UV As Double
    Dim Dot_UU As Double
        
    x = Dot_UV / Dot_UU
    w = scalar(x, u)
    
    proj = w
End Function

Function neg(u() As Double) As Double()
    Dim w(0 To 2) As Double
    w(0) = -1 * u(0)
    w(1) = -1 * u(1)
    w(2) = -1 * u(2)
    
    neg = w
End Function

To draw a vector in autocad, this is borrowed from the line wrapper, I kept the optional layer parameter even though i dont intend to use it much at first.

g_pt is a public point variable, same as a vector, if we set it each time, its easy to draw vectors end to end.
we could save the newly created line object the same way, and sometimes thats useful, but i removed it for now.

Public u() As Double
Public v() As Double
Public g_pt() As Double

Sub draw(vec() As Double, startpt() As Double, Optional strlayer As Variant)
    Dim lineobj As acadline
    Dim endpt() As Double
        
    endpt = pt(vec(0) + startpt(0), vec(1) + startpt(1), vec(2) + startpt(2))
    Set lineobj = acadDoc.ModelSpace.AddLine(startpt, endpt)
        
    If Not IsMissing(strlayer) Then
       lineobj.Layer = strlayer
    End If
         
    g_pt = endpt
 
  End Sub

Acad Table — Array — Excel Sheet

EXCEL — ARRAY — ACAD TABLE

Two way transfer of data to/from autocad table from/to excel worksheet using arrays.

Excel is the BOM (or cut-list) that Autocad has always needed, but editing tables in Autocad is slow and awkward. Being able to dump them back to excel, edit, then re-load them to the same table is sometimes much faster than editing in place.

We need 4 basic methods.

Excel range to array
Array to excel range
Autocad table to array
Array to autocad table

We will make functions and return the newly made or modified object. We will take object arguments for the input. We will keep these as single purpose as possible to be used by multiple calling programs.

Excel makes it easy to transfer sheet contents to an array or vice versa. It is simply

Array = range
Or
Range = array

There are some details. Acad Table requires a loop both to get and put data. When we do Array = Range then excel sizes the array automatically. We defined the range. When we make the array from the acad table, we Redim array (1 to rows, 1 to cols).

The four main sub/functions are –

Function xl_to_arr (rng as range) as variant
Sub arr_to_xl (arr as variant, rng as range)

Function acadtbl_to_arr(tbl as acadtable) as variant
Sub arr_to_acadtbl (arr as variant, tbl as acadtable)

If you use this method to delete rows (in autocad), keep the same number, re-sort rows, this works great as-is. You are just changing data. If you add rows or columns, you will likely have formatting problems. You can manually fix them. To do so programmatically, you would copy the formatting of the row above or column to the left. Its worth doing, but definitely non-trivial. Autocad tables have nearly 100 methods and properties. The vba help files for tables seem like many just appear to be stubs. For me, changing the alignment, tbl.SetCellAlignment r, c, acMiddleLeft Right or Center, and changing the texheight, SetTextHeight acDataRow (as opposed to Title or Header) dblvalue, do the job. Alignment is set per cell, and textheight only has to be set once if all rows are data rows. Non-trivial but worth doing.

This would be a good place to have a long discussion about arrays, but i am going to table that til i have my information better organized. Static arrays are not very useful, but all texts start there. Dynamic arrays are the norm. They can also accept assignment, which is not covered at all in most texts. I dont know when vba changed that, but they must have. There is no reason i have found not to use them all the time. Autocad uses variant arrays in their help when dynamic arrays would work fine. A variant data type can contain an array, and is the only choice most of the time to read and write to excel. Also the data in a table is going to be a combination of strings, integers and doubles, so a dynamic array of a single type wont work. I have a post in mind that is nothing but arrays.

An array made from an excel sheet always has a lower index of 1, no matter what the option base is. Autocad tables always have first row and column index of zero. Keep that straight and your loops will be simpler. I save the array from autocad with a base of 1.

For r = 1 To rows
For c = 1 To cols
arr(r, c) = tbl.GetText(r – 1, c – 1)
Next c
Next r

Traditional row and column variables for looping thru a table are i and j. I prefer r and c, row and column, for legibility. Rows always come first. (r,c) as distinct from excel sheet nomenclature (“A1”). Autocad tables are (r,c)

The four main subs are here, followed by the two calling programs, tbl_to_xl and xl_to_tbl. There is also a get_table function to return the object table from autocad by user selection. This could be selected other ways, such as by a location of the upper left of the table, if it is always at the same location. And last, there is an array report that writes to the debug window that i was using while developing and did not want to erase.

I can run both sides of the program from the code window or a button on a form. I have a sheet in excel with the proper name.

'the four main function subs
Function xl_to_arr(rng As Range) As Variant
     
     xl_to_arr = rng
     
End Function


Sub arr_to_xl(arr As Variant, rng As Range)
    Dim rows As Integer, cols As Integer
    rows = UBound(arr, 1) - LBound(arr, 1) + 1
    cols = UBound(arr, 2) - LBound(arr, 2) + 1
    
    'resize the range to be same as array
    Set rng = rng.Resize(rows, cols)
    
    rng.Value = arr
    'data is on the sheet
    
End Sub

Function acadtbl_to_arr(tbl As AcadTable) As Variant
    Dim r As Integer, c As Integer
    Dim rows As Integer, cols As Integer
    
    rows = tbl.rows
    cols = tbl.Columns
    
    Dim arr As Variant
    ReDim arr(1 To rows, 1 To cols)
    
    For r = 1 To rows
        For c = 1 To cols
            arr(r, c) = tbl.GetText(r - 1, c - 1)
        Next c
    Next r
    
    acadtbl_to_arr = arr

End Function


Sub arr_to_acadtbl(arr As Variant, tbl As AcadTable)

    Dim rowLbound As Integer, rowUbound As Integer
    Dim colLbound As Integer, colUbound As Integer
    Dim rows As Integer, cols As Integer
           
    rowLbound = LBound(arr, 1)
    rowUbound = UBound(arr, 1)
    colLbound = LBound(arr, 2)
    colUbound = UBound(arr, 2)

    rows = rowUbound - rowLbound + 1
    cols = colUbound - colLbound + 1
 
    'resize the autocad table
    tbl.rows = rows
    tbl.Columns = cols
  
  Dim r As Integer, c As Integer
  
If rowLbound <> 1 And colLbound <> 1 Then
MsgBox "Lbound not eq 1 in arr to acadtbl, exiting"
Exit Sub
End If

     For r = 1 To rows
         For c = 1 To cols
             If Not IsEmpty(arr(r, c)) Then
                tbl.SetText r - 1, c - 1, arr(r, c)
             End If
          Next c
       Next r

    acadApp.Update
     
End Sub

i use a couple globals in the calling programs.

Public g_tbl As AcadTable
Public g_arr As Variant

Sub tbl_to_xl()
    Call Connect_Acad
    
    Set g_tbl = get_table
     
     If g_tbl Is Nothing Then
     'MsgBox "table is nothing"
     Exit Sub
     End If
         
    g_arr = acadtbl_to_arr(g_tbl)
    
    Call arr_report(g_arr)
        
    Dim ws1 As Worksheet, rng As Range
    Set ws1 = ThisWorkbook.Sheets("Chan_List")
    Set rng = ws1.Range("A1")
        
    Call arr_to_xl(g_arr, rng)
    
    ws1.Activate
End Sub

Sub xl_to_tbl()
Call Connect_Acad

    If g_tbl Is Nothing Then
     Set g_tbl = get_table
     End If
 
    Dim ws1 As Worksheet, rng As Range
    Set ws1 = ThisWorkbook.Sheets("Chan_List")
    Set rng = ws1.Range("A1")
    Set rng = rng.CurrentRegion
     
    g_arr = xl_to_arr(rng)
    
     Call arr_report(g_arr)
    
    Call arr_to_acadtbl(g_arr, g_tbl)
End Sub


Function get_table() As AcadTable
        Dim pt() As Double
        Dim obj As Object
        On Error Resume Next
        
        acadDoc.Utility.GetEntity obj, pt, "Select a table"
    
    If Err <> 0 Or obj.EntityType <> acTable Then
        Err.Clear
        MsgBox "table not selected"
        Exit Function
    End If
    
    On Error GoTo 0
      
    If obj.EntityType = acTable Then
       Set get_table = obj
    End If
    
End Function


Sub arr_report(arr As Variant)
    
    Dim rowLbound As Integer, rowUbound As Integer
    Dim colLbound As Integer, colUbound As Integer
    Dim rows As Integer, cols As Integer
    
    rowLbound = LBound(arr, 1)
    rowUbound = UBound(arr, 1)
    colLbound = LBound(arr, 2)
    colUbound = UBound(arr, 2)
    
    rows = rowUbound - rowLbound + 1
    cols = colUbound - colLbound + 1
    
    Debug.Print "arr: " & IsArray(arr)
    Debug.Print "arr: " & VarType(arr)
    Debug.Print "arr: " & TypeName(arr)
     
    Debug.Print "row : " & rowLbound & " to "; rowUbound
    Debug.Print "col : " & colLbound & " to "; colUbound
    Debug.Print "rowcount: " & rows
    Debug.Print "colcount: " & cols
    
    Debug.Print
 
End Sub