VBA and Excel
VBA and Excel (85 Kb)
This is a sample VBA routine written for AutoCAD Rel 14. The application will demonstrate how to export data to Microsoft Excel, perform calculations on that data and then re-import the results of the calculations back into AutoCAD.
Usage
Unzip the files matlist.dvb, matlist.lsp, matlist.dwg and matlist.xls to your working directory.
Insert the matlist.Dwg. as a block into any drawing.
It should look like this :
Type (load "matlist") at the command prompt.
Type "matlist" to run the application.
(If you have problems when writing or running this projects, ensure that the Microsoft Excel 8.0 Object Library is selected in your VBA References.)
After running the application you can inspect the results of the exported data in the file matlist.xls. It should look something like this :
The Source Code
Public acad As Object Public doc As Object Public ms As Object Public ss As Object Public ssnew As Object Public Theatts As Variant Public MsgBoxResp As Integer 'declare global variables Private Sub CommandButton1_Click() UpdateAttrib 0, UserForm1.txt1.Text UpdateAttrib 1, UserForm1.txt2.Text UpdateAttrib 2, UserForm1.txt3.Text UpdateAttrib 3, UserForm1.txt4.Text UpdateAttrib 4, UserForm1.txt5.Text UpdateAttrib 5, UserForm1.txt6.Text UpdateAttrib 6, UserForm1.txt7.Text UpdateAttrib 7, UserForm1.txt8.Text UpdateAttrib 8, UserForm1.txt9.Text UpdateAttrib 9, UserForm1.txt10.Text UpdateAttrib 10, UserForm1.txt11.Text UpdateAttrib 11, UserForm1.txt12.Text UpdateAttrib 12, UserForm1.txt13.Text UpdateAttrib 13, UserForm1.txt14.Text UpdateAttrib 14, UserForm1.txt15.Text UpdateAttrib 15, UserForm1.txt16.Text UpdateAttrib 16, UserForm1.txt17.Text UpdateAttrib 17, UserForm1.txt18.Text UpdateAttrib 18, UserForm1.txt19.Text UpdateAttrib 19, UserForm1.txt20.Text UpdateAttrib 20, UserForm1.txt21.Text UpdateAttrib 21, UserForm1.txt22.Text UpdateAttrib 22, UserForm1.txt23.Text UpdateAttrib 23, UserForm1.txt24.Text UpdateAttrib 24, UserForm1.txt25.Text UpdateAttrib 25, UserForm1.txt26.Text UpdateAttrib 26, UserForm1.txt27.Text UpdateAttrib 27, UserForm1.txt28.Text UpdateAttrib 28, UserForm1.txt29.Text UpdateAttrib 29, UserForm1.txt30.Text UpdateAttrib 30, UserForm1.txt31.Text UpdateAttrib 31, UserForm1.txt32.Text UpdateAttrib 32, UserForm1.txt33.Text UpdateAttrib 33, UserForm1.txt34.Text UpdateAttrib 34, UserForm1.txt35.Text UpdateAttrib 35, UserForm1.txt36.Text 'get the attribute values ssnew.Item(0).Update 'update the attribute block End End Sub Sub UpdateAttrib(TagNumber As Integer, BTextString As String) 'This Sub Procedure tests the attribute data to check 'that is not a null value If BTextString = "" Then 'if the attribute is empty Theatts(TagNumber).TextString = "" 'put a '-' place holder Else 'if it is not empty Theatts(TagNumber).TextString = BTextString 'use the attribute value End If End Sub Private Sub CommandButton2_Click() End End Sub Private Sub CommandButton3_Click() Dim xlapp As Excel.Application Dim xlbook As Excel.Workbook Dim xlsheet As Excel.Worksheet 'declare local variables Set xlbook = GetObject("matlist.xls") 'set reference to Excel file Set xlapp = xlbook.Parent 'set reference to workbook xlapp.Visible = True 'make Excel visible xlapp.Windows("MATLIST.XLS").Visible = True 'make the workbook visible 'the 2 preceeding lines can be commented out if you 'do not want to see Excel in action Set xlsheet = xlbook.Sheets("SHEET1") 'set reference to the worksheet Sheet1 xlsheet.Cells(2, 1) = UserForm1.txt1.Text xlsheet.Cells(3, 1) = UserForm1.txt8.Text xlsheet.Cells(4, 1) = UserForm1.txt15.Text xlsheet.Cells(5, 1) = UserForm1.txt22.Text xlsheet.Cells(6, 1) = UserForm1.txt29.Text xlsheet.Cells(2, 2) = UserForm1.txt2.Text xlsheet.Cells(3, 2) = UserForm1.txt9.Text xlsheet.Cells(4, 2) = UserForm1.txt16.Text xlsheet.Cells(5, 2) = UserForm1.txt23.Text xlsheet.Cells(6, 2) = UserForm1.txt30.Text xlsheet.Cells(2, 3) = UserForm1.txt3.Text xlsheet.Cells(3, 3) = UserForm1.txt10.Text xlsheet.Cells(4, 3) = UserForm1.txt17.Text xlsheet.Cells(5, 3) = UserForm1.txt24.Text xlsheet.Cells(6, 3) = UserForm1.txt31.Text xlsheet.Cells(2, 4) = UserForm1.txt4.Text xlsheet.Cells(3, 4) = UserForm1.txt11.Text xlsheet.Cells(4, 4) = UserForm1.txt18.Text xlsheet.Cells(5, 4) = UserForm1.txt25.Text xlsheet.Cells(6, 4) = UserForm1.txt32.Text xlsheet.Cells(2, 5) = UserForm1.txt5.Text xlsheet.Cells(3, 5) = UserForm1.txt12.Text xlsheet.Cells(4, 5) = UserForm1.txt19.Text xlsheet.Cells(5, 5) = UserForm1.txt26.Text xlsheet.Cells(6, 5) = UserForm1.txt33.Text xlsheet.Cells(2, 7) = UserForm1.txt7.Text xlsheet.Cells(3, 7) = UserForm1.txt14.Text xlsheet.Cells(4, 7) = UserForm1.txt21.Text xlsheet.Cells(5, 7) = UserForm1.txt28.Text xlsheet.Cells(6, 7) = UserForm1.txt35.Text 'fill the worksheet cells with the attribute values UserForm1.txt6.Text = xlsheet.Cells(2, 6) UserForm1.txt13.Text = xlsheet.Cells(3, 6) UserForm1.txt20.Text = xlsheet.Cells(4, 6) UserForm1.txt27.Text = xlsheet.Cells(5, 6) UserForm1.txt34.Text = xlsheet.Cells(6, 6) UserForm1.txt36.Text = xlsheet.Cells(7, 6) 'retrieve the calculated attribute values xlbook.Close savechanges:=True 'save the changes in Excel xlapp.Quit 'quit Excel Set xlsheet = Nothing Set xlbook = Nothing Set axlapp = Nothing 'clean up End Sub Private Sub UserForm_Initialize() Dim BlkG(0) As Integer Dim TheBlock(0) As Variant Dim Pt1(0 To 2) As Double Dim Pt2(0 To 2) As Double 'declare local variables Set acad = GetObject(, "AutoCAD.Application") 'set reference to AutoCAD Set doc = acad.ActiveDocument 'set reference to the drawing Set ms = doc.ModelSpace 'set reference to model space Set ssnew = doc.SelectionSets.Add("TBLK") 'create a selection set Pt1(0) = 0: Pt1(1) = 0: Pt1(2) = 0 Pt2(0) = 3: Pt2(1) = 3: Pt2(2) = 0 'set up the array BlkG(0) = 2 'group code 2 for block name TheBlock(0) = "MATLIST" 'the name of the attribute block ssnew.Select 5, Pt1, Pt2, BlkG, TheBlock 'get the block If ssnew.Count >= 1 Then 'if the block is found Theatts = ssnew.Item(0).GetAttributes 'get the attributes UserForm1.txt1.Text = UCase(LTrim(Theatts(0).TextString)) 'get the title attribute 'clear any leading spaces and 'convert to uppercase UserForm1.txt2.Text = UCase(LTrim(Theatts(1).TextString)) UserForm1.txt3.Text = UCase(LTrim(Theatts(2).TextString)) UserForm1.txt4.Text = UCase(LTrim(Theatts(3).TextString)) UserForm1.txt5.Text = UCase(LTrim(Theatts(4).TextString)) UserForm1.txt6.Text = UCase(LTrim(Theatts(5).TextString)) UserForm1.txt7.Text = UCase(LTrim(Theatts(6).TextString)) UserForm1.txt8.Text = UCase(LTrim(Theatts(7).TextString)) UserForm1.txt9.Text = UCase(LTrim(Theatts(8).TextString)) UserForm1.txt10.Text = UCase(LTrim(Theatts(9).TextString)) UserForm1.txt11.Text = UCase(LTrim(Theatts(10).TextString)) UserForm1.txt12.Text = UCase(LTrim(Theatts(11).TextString)) UserForm1.txt13.Text = UCase(LTrim(Theatts(12).TextString)) UserForm1.txt14.Text = UCase(LTrim(Theatts(13).TextString)) UserForm1.txt15.Text = UCase(LTrim(Theatts(14).TextString)) UserForm1.txt16.Text = UCase(LTrim(Theatts(15).TextString)) UserForm1.txt17.Text = UCase(LTrim(Theatts(16).TextString)) UserForm1.txt18.Text = UCase(LTrim(Theatts(17).TextString)) UserForm1.txt19.Text = UCase(LTrim(Theatts(18).TextString)) UserForm1.txt20.Text = UCase(LTrim(Theatts(19).TextString)) UserForm1.txt21.Text = UCase(LTrim(Theatts(20).TextString)) UserForm1.txt22.Text = UCase(LTrim(Theatts(21).TextString)) UserForm1.txt23.Text = UCase(LTrim(Theatts(22).TextString)) UserForm1.txt24.Text = UCase(LTrim(Theatts(23).TextString)) UserForm1.txt25.Text = UCase(LTrim(Theatts(24).TextString)) UserForm1.txt26.Text = UCase(LTrim(Theatts(25).TextString)) UserForm1.txt27.Text = UCase(LTrim(Theatts(26).TextString)) UserForm1.txt28.Text = UCase(LTrim(Theatts(27).TextString)) UserForm1.txt29.Text = UCase(LTrim(Theatts(28).TextString)) UserForm1.txt30.Text = UCase(LTrim(Theatts(29).TextString)) UserForm1.txt31.Text = UCase(LTrim(Theatts(30).TextString)) UserForm1.txt32.Text = UCase(LTrim(Theatts(31).TextString)) UserForm1.txt33.Text = UCase(LTrim(Theatts(32).TextString)) UserForm1.txt34.Text = UCase(LTrim(Theatts(33).TextString)) UserForm1.txt35.Text = UCase(LTrim(Theatts(34).TextString)) UserForm1.txt36.Text = UCase(LTrim(Theatts(35).TextString)) UserForm1.txt1.SetFocus UserForm1.txt1.SelStart = 0 UserForm1.txt1.SelLength = Len(UserForm1.txt1.Text) 'set the focus to the drawing title and highlight it Else 'if no attribute title block is found MsgBox "Sorry - No Material List Attributes....", vbCritical, _ "AfraLisp Tutorial" 'inform the user that there is no attribute title block ThisDrawing.SelectionSets("TBLK").Delete End 'end the application End If ThisDrawing.SelectionSets("TBLK").Delete End Sub
Now create a Module named Tblock :
Sub matlist() UserForm1.Show End Sub