Convert Excel Range to vertices
Motivated by several posts here I started to write a routine that would draw a LWPolyline in BricsCAD using a listing of 2D points stored in Excel.As I found that the AddLightWeightPolyline(points) method uses a 1D array, I started writing a function that converts a 2D Excel range object to a 1D VerticesList I failed at that as my function generated an array type 'Variant' and AddLightWeightPolyline requires a type 'Double'. My conversion is now part of the main routine. The next code works, but if some-one could help me in moving the part Redim ... For i = ... Next ito a function., I would be very gratefulIn the mean time I hope this code is useful to some of you.THIS IS STORED IN A EXCEL VBA MODULE'ActiveWorksheet' should contain some 2D points in Column A and B, (first point assumed in second row)Option ExplicitDim objDWG As AcadDocumentDim objACAD As AcadApplicationSub DrawAnExcelRange() Dim rngData As Variant Dim dblVertices() As Double Dim LWpline As AcadLWPolyline Dim i As Long Set objACAD = New BricscadApp.AcadApplication Set objDWG = objACAD.ActiveDocument rngData = ActiveSheet.Range(Cells(2, 1), Cells(Cells(2, 1).End(xlDown).Row, 2)).Value ReDim dblVertices(0 To 2 * UBound(rngData, 1) - 1) For i = 1 To UBound(rngData, 1) dblVertices(2 * i - 2) = CDbl(rngData(i, 1)) dblVertices(2 * i - 1) = CDbl(rngData(i, 2)) Next i Set LWpline = objDWG.ModelSpace.AddLightWeightPolyline(dblVertices) LWpline.Update objDWG.SaveAs "C:\TMP\TEST.DWG" objACAD.Quit Set objDWG = Nothing Set objACAD = NothingEnd Sub
Comments
-
Two corrections.I write 'converts a 2D Excel range object', but I don't use a range object: it is a 2D arrayThen: for it to work in MS-Excel, in the VBE references should be made to BricsCad App 1.0 Type Library and the BricsCad DB 2.4 Type Library
0 -
Function ToArray(inRange As Variant) As Double() ReDim A(0 To 2 * UBound(inRange, 1) - 1) As Double Dim i As Integer For i = 1 To UBound(inRange, 1) A(2 * i - 2) = CDbl(inRange(i, 1)) A(2 * i - 1) = CDbl(inRange(i, 2)) Next i ToArray = AEnd Functionin main you could call it like thisSet LWpline = objDWG.ModelSpace.AddLightWeightPolyline(ToArray(rngData))
0 -
Thank you very much, Ferdinand!I was very close to that, great you helped me out.Gerrit
0
