# Category Archives: autocad graphing calculator

# Creating the Graph Point Data

Autocad AddLightWeightPolyline method requires an array of doubles. It does not require the lowerbound of the array to be zero. An array simply has to have an even number of elements, one element for each X and each Y alternating. (x1, y1, x2, y2, x3, y3…) For indexes and loops I typically use the counting numbers, which do not include zero. I am evaluating an autocad work-alike program that is similar but requires arrays to be zero-based. It does not throw an error with a one-based array but results are a failure. it creates zero values for non-existent indexes that it expects. However there is no reason the arrays cannot be zero-based so they run in both packages. To that end for that reason i am re-doing the graph loops.

Only the array needs to be zero based. The loop still executes one time for each point. The index of the array starts with zero.

Calculation of points for Coordinate XY graphing –

Autocad does not care what indexes the array pt (below) was created with. The work-alike absolutely requires a starting index of zero.

Dim plineobj As AcadLWPolyline Set plineobj = acadDoc.ModelSpace.AddLightWeightPolyline(pt)

in line drawing mode, subtracting lbound from ubound adding one and dividing by two will give the number of points in the array. There is one less line. Since we know lbound is zero we could remove that. The loop iterates once for each line drawn. We could do the loop to handle any lbound value, but it would be a little messy with no immediate benefit. For now we expect a zero base array.

Sub draw_lines(ByRef pt() As Double) Dim lineobj As AcadLine Dim i As Integer, numpts As Integer, numlines As Integer Dim x1 As Double, x2 As Double, y1 As Double, y2 As Double Dim pt1(0 To 2) As Double Dim pt2(0 To 2) As Double numpts = (UBound(pt) - LBound(pt) + 1) / 2 numlines = numpts - 1 'this requires a zero base array For i = 1 To numlines x1 = pt(i * 2 - 2) y1 = pt(i * 2 - 1) x2 = pt(i * 2) y2 = pt(i * 2 + 1) pt1(0) = x1: pt1(1) = y1: pt1(2) = 0 pt2(0) = x2: pt2(1) = y2: pt2(2) = 0 Set lineobj = acadApp.ActiveDocument.ModelSpace.AddLine(pt1, pt2) Next i Update End Sub

Lines w/limits mode we use when the Y value approaches infinity, such as y=1/x near x=0. It is otherwise the same.

Sub draw_lines_wlimits(xlim As Double, ylim As Double, ByRef pt() As Double) Dim lineobj As AcadLine Dim i As Integer, numpts As Integer, numlines As Integer Dim x1 As Double, x2 As Double, y1 As Double, y2 As Double Dim pt1(0 To 2) As Double Dim pt2(0 To 2) As Double numpts = (UBound(pt) - LBound(pt) + 1) / 2 numlines = numpts - 1 'this requires a zero base array For i = 1 To numlines x1 = pt(i * 2 - 2) y1 = pt(i * 2 - 1) x2 = pt(i * 2) y2 = pt(i * 2 + 1) If Abs(x1) < xlim And Abs(y1) < ylim And Abs(x2) < xlim And Abs(y2) < ylim Then pt1(0) = x1: pt1(1) = y1: pt1(2) = 0 pt2(0) = x2: pt2(1) = y2: pt2(2) = 0 Set lineobj = acadApp.ActiveDocument.ModelSpace.AddLine(pt1, pt2) End If Next i Update End Sub

point mode

Sub draw_points(ByRef pt() As Double) Call pointmode Dim pointobj As AcadPoint Dim i As Integer, numpts As Integer Dim x1 As Double, y1 As Double Dim pt1(0 To 2) As Double numpts = (UBound(pt) - LBound(pt) + 1) / 2 'this requires a zero base array For i = 1 To numpts x1 = pt(i * 2 - 2) y1 = pt(i * 2 - 1) pt1(0) = x1: pt1(1) = y1: pt1(2) = 0 Set pointobj = acadDoc.ModelSpace.AddPoint(pt1) Next i Update End Sub

# Autocad Graphing Calculator

Autocad has Euclidean roots. Its a classic geometry tool. And it has VBA. It is not necessary to download and install the VBA module to have full access to VBA through Excel.

this blog online 1 year with 100 pages, approx, More to come.

i apologize for the old posts with messed up links and code mangling. wordpress changed their editor last year and between them and me changing the theme, we messed up a few pages that were ok when first published. i just noticed some new broken links.

Lissajous curves gone wrong. I unchecked the convert to Radians button in the Parametric form before graphing, so that Sin(360) is interpreted by VBA not as Sin(2 pi) but Sin(360) or in radians Sin(57 * 2 pi) approx, but more importantly the step increment between points instead of being 1 degree is 1 radian or 57 degrees.

# the Cochleoid

the Cochleoid is a polar spiral that spirals in on itself, because Sin A varies between -1 and 1, but A gets ever larger.

at point 8 A is 210, not 30, but because the Sin is negative, R is negative. The graph passes thru 0,0 every time the sin is zero.

running the graph from negative 1080 (-6 pi) to -1 (to avoid divide by zero error) draws the mirror image graph from the inside out.

wolfram reference

http://mathworld.wolfram.com/Cochleoid.html

# Autocad VBA Font Tables

Tablestyles can be added and programmed without duplicating code by using a global variable for the AcadTableStyle object. This is a flexible method for getting a handle on them.

but first – make font tables in autocad – run a loop from 0 to 255 to advance the Chr(#), change the textstyle of the table style to instantly change the table.

Sub test_array_to_acadtable3() '0 to 255 ascii table 'font style is set in the table style 'send the array to the maketable routine Call connect_acad Dim rows As Integer, i As Integer Dim columns As Integer, j As Integer rows = 16 columns = 16 Dim ar_mult() As String ReDim ar_mult(1 To rows, 1 To columns) For i = 1 To rows For j = 1 To columns ar_mult(i, j) = Chr((i - 1) * 16 + (j - 1)) Next j Next i Call makethetable3(ar_mult) End Sub

# VBA Arrays and Autocad Tables

Here is the basic routine for making an autocad table from an array in its simplest form from a one-based array, and a generalized form that creates a table from any two-dimensional array.

Sub test_array_to_acadtable1() 'test to make a one-based two dimensional array of numbers 'and send the array to the maketable routines Call connect_acad Dim rows As Integer, i As Integer Dim columns As Integer, j As Integer 'change these to anything you like rows = 14 columns = 16 Dim ar_mult() As Integer ReDim ar_mult(1 To rows, 1 To columns) For i = 1 To rows For j = 1 To columns ar_mult(i, j) = i * j Next j Next i 'makes two identical tables Call makethetable2(ar_mult) Call makethetable3(ar_mult) End Sub Sub test_array_to_acadtable2() 'test to make a random-based two dimensional array of numbers 'and send the array to the maketable routine 'that has been generalized to accept an array of any base Call connect_acad Dim rows As Integer, i As Integer Dim columns As Integer, j As Integer 'change these to anything you like rows = 14 columns = 16 Dim ar_mult() As Integer ReDim ar_mult(3 To rows + 2, 3 To columns + 2) For i = 3 To rows + 2 For j = 3 To columns + 2 ar_mult(i, j) = (i - 2) * (j - 2) Next j Next i Call makethetable3(ar_mult) End Sub Sub makethetable3(ar As Variant) 'table is two-dimensional and any-base Dim tbl As AcadTable Dim i As Integer, j As Integer Dim rowcount As Integer, colcount As Integer Dim rowLbound As Integer, colLbound As Integer Dim rowUbound As Integer, colUbound As Integer Dim drowh As Double, dcolw As Double Dim pt0(0 To 2) As Double rowLbound = LBound(ar, 1) colLbound = LBound(ar, 2) rowUbound = UBound(ar, 1) colUbound = UBound(ar, 2) rowcount = rowUbound - rowLbound + 1 colcount = colUbound - colLbound + 1 drowh = 0.125 dcolw = 0.625 Set tbl = acadDoc.ModelSpace.AddTable(pt0, rowcount, colcount, drowh, dcolw) tbl.UnmergeCells 0, 0, 0, 0 tbl.TitleSuppressed = True tbl.HeaderSuppressed = True For i = rowLbound To rowUbound For j = colLbound To colUbound tbl.SetText i - colLbound, j - rowLbound, ar(i, j) Next j Next i End Sub Sub makethetable2(ar As Variant) 'the simpler routine 'assume table is two-dimensional and one-base 'no attempt to set up a tablestyle 'which makes the unmerge method necessary Dim tbl As AcadTable Dim i As Integer, j As Integer Dim rowcount As Integer, colcount As Integer Dim drowh As Double, dcolw As Double Dim pt0(0 To 2) As Double rowcount = UBound(ar, 1) colcount = UBound(ar, 2) drowh = 0.125 dcolw = 0.625 'create the table sized for the array Set tbl = acadDoc.ModelSpace.AddTable(pt0, rowcount, colcount, drowh, dcolw) tbl.UnmergeCells 0, 0, 0, 0 tbl.TitleSuppressed = True tbl.HeaderSuppressed = True For i = 1 To rowcount For j = 1 To colcount tbl.SetText i - 1, j - 1, ar(i, j) Next j Next i End Sub

any selection of data on a spreadsheet can be saved to an array with a single line of code, and the array fed to the makethetable routine. of course the formatting is terrible but we have tools for that.

Sub make_table_from_selection() Dim ar_tbl As Variant ar_tbl = Selection.Value 'a selection assigned to a variant 'creates a one-based two-dimension array 'the first dim is the row, the second is the column 'MsgBox LBound(ar_tbl, 1) returns 1 'MsgBox LBound(ar_tbl, 2) returns 1 Call connect_acad Call makethetable3(ar_tbl) End Sub

# Autocad VBA Tables

Autocad has over 200 table and table style methods and properties. Many of these are overlapping uncertain as to application. The ActiveX help is not much. I imagine whoever turned it over to his/her boss said this is just a framework, i need to put as many hours in to finish it. and there it stands. however, the multitude of options show how fully it is implemented. the autocad interfaces are very good. in fact that is the only way to learn how to use the methods, study the user interfaces and find their vba counterparts. The realization comes that there is not much to be gained by duplicating the user interface in vba. the work flow is to assemble data in excel, format it in excel, then use the pastespecial command in autocad to paste the data to a table complete with formatting.

you can start to sort out the activex help by copy pasting the methods page to an excel sheet. the links transfer and you can begin to assemble the most required methods and add your own notes.

the > 200 table methods. these encompass the table and the tabledit command. tabledit is accessed by rightclicking the table, and by the properties window, as well as the ribbon panel for tables.

Autocad 2016 Table Methods and Properties ActiveX VBA

there are fewer tablestyle methods.

Autocad 2016 TableStyle Methods and Properties ActiveX VBA

here is some barebones beginning code to create a multiplication table, any size, with an array. Arrays are natural tools to use with tables, whether in excel or autocad. Feed the array to a make table subprocedure which makes the autocad table and sizes it the same as the array. There is no attempt to create a tablestyle, which makes it necessary to run the unmerge method. Even though no tablestyle is selected, the table has a default, whatever is current, which is likely the “Standard” that automatically merges the first row and makes it a “Title” row. There is also some commented out code that writes the data to a new sheet. And some commented out code which demonstrates how to obtain the data for the autocad table from a spreadsheet.

Sub test() DelSht ("new_sheet1") CreateSheet ("new_sheet1") Dim rows As Integer, i As Integer Dim columns As Integer, j As Integer 'change these to anything you like rows = 12 columns = 12 Dim ar_mult() As Integer ReDim ar_mult(1 To rows, 1 To columns) For i = 1 To rows For j = 1 To columns ar_mult(i, j) = i * j Next j Next i 'this comment block demonstrates taking spreadsheet data to autocad table 'Dim rng As Range 'Worksheets("new_sheet1").Activate 'Set rng = Range("B2", Cells(rows + 1, columns + 1)) 'rng = ar_mult 'Dim ar2 As Variant 'ar2 = rng 'Call makethetable1(ar2) Call makethetable1(ar_mult) End Sub Sub makethetable1(ar As Variant) 'first attempt assume table is two-dimensional and one-base 'no attempt to set up a tablestyle 'which makes the unmerge method necessary Call connect_acad Dim tbl As AcadTable Dim i As Integer, j As Integer Dim rowcount As Integer, colcount As Integer Dim drowh As Double, dcolw As Double Dim pt0(0 To 2) As Double rowcount = UBound(ar, 1) colcount = UBound(ar, 2) drowh = 0.125 dcolw = 1 'create the table sized for the array Set tbl = acadDoc.ModelSpace.AddTable(pt0, rowcount, colcount, drowh, dcolw) 'object.UnmergeCells minRow, maxRow, minCol, maxCol tbl.UnmergeCells 0, 0, 0, 0 With tbl For i = 1 To rowcount For j = 1 To colcount If Not IsEmpty(ar(i, j)) Then .SetText i - 1, j - 1, ar(i, j) End If Next j Next i End With tbl.Update ZoomExtents End Sub

to conquer the tablestyle creation, you need to remember the enumeration constants, such as acdatarow and acHorzBottom can be added up. their values can be obtained for reference by typing in the immediate window. if you want your entire grid to be blue, you can do it with one line of code.

Sub table_style_full() 'sets a full table style with title and header Call connect_acad Dim dictionaries As AcadDictionaries Dim dictObj As AcadDictionary Set dictionaries = acadDoc.Database.dictionaries Set dictObj = dictionaries.Item("acad_tablestyle") Dim keyName As String, className As String Dim TS As AcadTableStyle keyName = "Tb_full" className = "AcDbTableStyle" Set TS = dictObj.AddObject(keyName, className) TS.Name = "Tb_full" TS.Description = "Style data" TS.TitleSuppressed = False TS.HeaderSuppressed = False TS.BitFlags = 1 TS.FlowDirection = acTableTopToBottom TS.EnableMergeAll "Title", True TS.HorzCellMargin = 0.06 TS.VertCellMargin = 0.03 ' affects the height of the cell TS.SetTextHeight acTitleRow, 0.25 TS.SetTextHeight acHeaderRow, 0.1875 TS.SetTextHeight acDataRow, 0.125 'doesnt like it if these are not already created TS.SetTextStyle acTitleRow, "Arial" TS.SetTextStyle acHeaderRow, "Arial" TS.SetTextStyle acDataRow, "ArialN" TS.SetAlignment acTitleRow, acMiddleCenter TS.SetAlignment acHeaderRow, acMiddleCenter TS.SetAlignment acDataRow, acMiddleRight Dim col As AcadAcCmColor Set col = AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor.20") 'Blue Call col.SetRGB(0, 0, 255) 'gridlinetypes 'acHorzBottom 4 'acHorzInside 2 'acHorzTop 1 'acVertInside 16 'acVertLeft 8 'acVertRight 32 'border sum is 63 'rowtypes 'acdatarow 1 'acTitleRow 2 'acHeaderRow 4 'row sum is 7 'setgridcolor gridlinetypes, rowtypes, color TS.SetGridColor 63, 7, col TS.SetGridVisibility 63, 7, True Call col.SetRGB(0, 0, 0) 'setcolor rowtypes, color TS.SetColor 7, col 'Set col = TS.GetColor(acDataRow) 'MsgBox col.Red & col.Green & col.Blue 'Set col = TS.GetBackgroundColor(acDataRow) 'MsgBox col.Red & col.Green & col.Blue TS.SetBackgroundColor 7, col TS.SetBackgroundColorNone 7, True acadDoc.SetVariable ("ctablestyle"), "Tb_full" acadDoc.SetVariable ("clayer"), "0" End Sub

well i thought that i could create a tablestyle with a comprehensive sub procedure, setting nearly every variable, set it to current, then create a new tablestyle and it would inherit the current values, but it does not. the user interface works that way, it starts with the the current style, but vba creation does not. i wanted to have a tablestyle library that did not duplicate code. i tried changing the “Standard” style, as it seems that is the template, setting that current, but still the inherited values in the new unset tablestyle seem to come from an intrinsic standard, not the “Standard.” thats ok, we will refine our basic tablestyle routine and copy / modify it as required.

i need to learn how to format, for example displaying a calculated double like 1/3 with a desired number of decimal places, and investigate the difference between SetTextString and SetText and SetValue and SetCellValue, and the difference between SetFormat and SetCellFormat and SetDataFormat, some jobs like that, other than that, we have many if not most of the tools we need demonstrated.

Sub test() Call connect_acad acadApp.Preferences.Display.GraphicsWinModelBackgrndColor = 16250871 acadDoc.SetVariable "LWDISPLAY", 1 Call set_text_style Dim rows As Integer, i As Integer Dim columns As Integer, j As Integer 'change these to anything you like rows = 14 columns = 14 Dim ar_mult() As Integer ReDim ar_mult(1 To rows, 1 To columns) For i = 1 To rows For j = 1 To columns ar_mult(i, j) = i * j Next j Next i 'this comment block demonstrates taking spreadsheet data to autocad table 'DelSht ("new_sheet1") 'CreateSheet ("new_sheet1") 'Dim rng As Range 'Worksheets("new_sheet1").Activate 'Set rng = Range("B2", Cells(rows + 1, columns + 1)) 'rng = ar_mult 'Dim ar2 As Variant 'ar2 = rng 'Call makethetable1(ar2) Call table_style_data Call makethetable1(ar_mult) End Sub

Sub table_style_data() 'doesnt influence 'Call table_style_full Dim dictionaries As AcadDictionaries Dim dictObj As AcadDictionary Set dictionaries = acadDoc.Database.dictionaries Set dictObj = dictionaries.Item("acad_tablestyle") Dim keyName As String, className As String Dim TS As AcadTableStyle keyName = "Tb_data" className = "AcDbTableStyle" Set TS = dictObj.AddObject(keyName, className) TS.Name = "Tb_data" TS.Description = "Style data" TS.TitleSuppressed = True TS.HeaderSuppressed = True TS.HorzCellMargin = 0.03 TS.VertCellMargin = 0.03 ' affects the height of the cell TS.SetTextHeight acTitleRow, 0.125 TS.SetTextHeight acHeaderRow, 0.125 TS.SetTextHeight acDataRow, 0.125 Dim col As AcadAcCmColor Set col = AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor.20") ' 'Blue Call col.SetRGB(0, 0, 255) TS.SetGridColor 63, 7, col TS.SetGridLineWeight 63, 7, acLnWt030 TS.SetTextStyle acDataRow, "Tempus Sans ITC" acadDoc.SetVariable ("ctablestyle"), "Tb_data" acadDoc.SetVariable ("clayer"), "0" End Sub

Sub makethetable1(ar As Variant) 'first attempt assume table is two-dimensional and one-base 'no attempt to set up a tablestyle 'which makes the unmerge method necessary Call connect_acad Dim tbl As AcadTable Dim i As Integer, j As Integer Dim rowcount As Integer, colcount As Integer Dim drowh As Double, dcolw As Double Dim pt0(0 To 2) As Double rowcount = UBound(ar, 1) colcount = UBound(ar, 2) drowh = 0.125 dcolw = 0.5 'create the table sized for the array Set tbl = acadDoc.ModelSpace.AddTable(pt0, rowcount, colcount, drowh, dcolw) 'object.UnmergeCells minRow, maxRow, minCol, maxCol tbl.UnmergeCells 0, 0, 0, 0 tbl.TitleSuppressed = True tbl.HeaderSuppressed = True With tbl For i = 1 To rowcount For j = 1 To colcount If Not IsEmpty(ar(i, j)) Then .SetText i - 1, j - 1, ar(i, j) End If Next j Next i End With ZoomExtents 'tbl.GenerateLayout End Sub