The only input the Autocad VBA Lightweight 2D Polyline accepts is an array of doubles, a list of xy pairs, a single dimension array. The array size is always a multiple of 2. The X and Y points are saved alternately one after another. The point list array has to have a minimum of four values.

X is the independent variable in the function y=f(x). The allowable values of x are called the domain. In math they are all values that can arithmetically produce a Y value. In a program, we have to select a definite span and an increment. The span divided by the increment produce the number of line segments we are going to draw. There is always one more point than line segment. When we have the number of points, we re-size our point list array to number of points times two for all x and y values. We use the same integer numpts to control the loop, each time through adding an X and Y value to the array.

Dim pt() as Double
numlines = (Xmax - Xmin) / X_inc 'number of line segments
numpts = numlines + 1 'one more pt than line segment
ReDim pt(1 To numpts * 2) 'store x and y for one pt
For i = 1 To numpts
X = Xmin + ((i - 1) * X_inc)
Y = f(x) ' function goes here
pt(i * 2 - 1) = X: pt(i * 2) = Y
Next i
Set plineobj = acadDoc.ModelSpace.AddLightWeightPolyline(pt)
Call display_pt2(pt)

The point list array is easily written to a spreadsheet. A utility program creates a new sheet, deletes an old one if it exists, and moves the sheet to the end. The array pt() is passed as an argument. The receiving program checks to make sure its divisible by two, gets the upper index with Ubound, and writes the XY point list in two columns to an excel sheet.

Sub display_pt2(pt() As Double)
If ((UBound(pt) - LBound(pt) + 1) Mod 2) <> 0 Then
MsgBox "array not divisible by 2"
Exit Sub
End If
NewSht ("func_data_list_2")
Dim i As Integer
Dim numrows As Integer
'expects LBound to be 1
numrows = UBound(pt) / 2
For i = 1 To numrows
Cells(i, 1) = pt(i * 2 - 1)
Cells(i, 2) = pt(i * 2)
Next i
End Sub
Sub NewSht(strSheetName As String)
Application.DisplayAlerts = False
On Error Resume Next
Worksheets(strSheetName).Delete
Worksheets.Add.Name = strSheetName
Worksheets(strSheetName).Move after:=Worksheets(Worksheets.Count)
Worksheets(strSheetName).Activate
End Sub

### Like this:

Like Loading...

*Related*