Draw a rectangle in ACAD from Excel

[snglvl]

Hi friends, I am using AutoCAD 2012. I have a list of Dimensions of rectangle in an Excel sheet (inputList.xlsx) and i need to create rectangles in autocad and save them in dxf format in a folder w/o actually opening autocad . Can anyone help??? I ve knowledge in vba in excel side...

[Dadgad]

Welcome to CADTutor.

 

Sorry I can't help you with that, but if somebody does that for you, hopefully they will be able to write one for me that will do my days work

without my opening Autocad, or my eyes.

Sorry, couldn't help myself, please be patient and likely somebody will help you work the magic.

[MSasu]

You may access the AutoCAD application via COM technology:

Set appAutoCAD = CreateObject("AutoCAD.Application")

However, you may choose to hide its interface, but AutoCAD should be open in order to edit drawings.

myDrawing.Application.Visible = False

[MSasu]

By the way, the easiest solution will be to create a script from those ccordinates, either by formatting data in Excel or by a VBA automation, and call it later in AutoCAD.

_RECTANGLE 0.0,0.0 10.0,10.0
;end of script

[steven-g]

Hi friends, I am using AutoCAD 2012. I have a list of Dimensions of rectangle in an Excel sheet (inputList.xlsx) and i need to create rectangles in autocad and save them in dxf format in a folder w/o actually opening autocad . Can anyone help??? I ve knowledge in vba in excel side...

If you format your data in excel so that the rectangle coordinates are stored in the first 4 columns.

column A contains the first x coordinate

column B contains the first y coordinate

column C contains the second x coordinate

column D contains the second y coordinate

 

then the following code will create a script file that you can just drag into an open autocad window

 

Sub WriteToTextFile1()
   Dim iFileNumber                        As Long
   Dim strFileName                        As String
   iFileNumber = FreeFile()
   strFileName = "C:\scr\test.scr"         'name and location of the script file
   Open strFileName For Output As #iFileNumber
   For r = 1 To 2                          'row number of data
   Print #iFileNumber, "rectangle"
   x1 = Cells(r, 1).Value
   y1 = Cells(r, 2).Value
   x2 = Cells(r, 3).Value
   y2 = Cells(r, 4).Value
   Print #iFileNumber, x1 & "," & y1  'first point of rectangel
   Print #iFileNumber, x2 & "," & y2  'second point of rectangle
   Next
   Close #iFileNumber
End Sub

You can change the file name to suit and you will need to create the folder, alter the value of "r" to how many rows of data you have. One last thing make sure all your osnaps are turned off, even when running a script autocad will snap to a point if it is close to your coordinates. Test this out on a blank drawing file first and always make backups of any drawings before you run a script in them.

This is the basics of creating a script using Excel VBA, you can add to it in order to create your DXF files, just work out your command sequence and add those to the script.

[snglvl]

This code i used in VBA (AutoCAD) to create a Rectangle

 

Private Sub CommandButton1_Click()
Pi = 3.14159265358979
UserForm1.Hide
pt1 = ThisDrawing.Utility.GetPoint(, "Pick Lower Left Corner:")
pt2 = ThisDrawing.Utility.PolarPoint(pt1, 0, Val(TextBox1.Text))
pt3 = ThisDrawing.Utility.PolarPoint(pt2, Pi / 2, Val(TextBox2.Text))
pt4 = ThisDrawing.Utility.PolarPoint(pt1, Pi / 2, Val(TextBox2.Text))
ThisDrawing.ModelSpace.AddLine pt1, pt2
ThisDrawing.ModelSpace.AddLine pt2, pt3
ThisDrawing.ModelSpace.AddLine pt3, pt4
ThisDrawing.ModelSpace.AddLine pt4, pt1
ThisDrawing.ModelSpace.AddCircle pt1, Val(TextBox2.Text) / 2

End Sub

 

But it uses a userform and gets data from user and it is from AutoCAD

 

I need to do it from Excel and inputs from excel...

Edited November 18, 2013 by SLW210
Added Code Tags!

[SLW210]

Please read Code posting guidelines and use Code Tags.

[fixo]

Please, attach a screenshot of Excel file for test,

it's not clearly enough how is your data filled in there

Say if your coordinates in 8 columns per even row,

try this example

Option Explicit


'---------------------------------------------------------------'


' Notes:


' 1. requires settings: Tools -> Options -> General tab -> Error 
trapping field -> check "Break on Unhandled errors"


' 2. requires reference to Microsoft Excel XX.0 Object Library


'---------------------------------------------------------------'


' written by Sccadmember


' Date: Aug/04/06


' [url]http://discussion.autodesk.com/thread.jspa?threadID=489202[/url]


' Just thought I would post this because I have been looking for a working 
VBA file open dialog box


' solution for awhile. 'I'm an old autolisped making the jump to VBA and I 
have seen and read


' various solutons for the equivalent getfiled 'autolisp function but I never 
had much luck with them.


' This one worked for me it uses the Win API to do the job.


'---------------------------------------------------------------'


Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _


"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long


Private Type OPENFILENAME


lStructSize As Long


hwndOwner As Long


hInstance As Long


lpstrFilter As String


lpstrCustomFilter As String


nMaxCustFilter As Long


nFilterIndex As Long


lpstrFile As String


nMaxFile As Long


lpstrFileTitle As String


nMaxFileTitle As Long


lpstrInitialDir As String


lpstrTitle As String


flags As Long


nFileOffset As Integer


nFileExtension As Integer


lpstrDefExt As String


lCustData As Long


lpfnHook As Long


lpTemplateName As String


End Type


'---------------------------------------------------------------'


Public Function ShowOpen(Filter As String, _


InitialDir As String, _


DialogTitle As String) As String


Dim OFName As OPENFILENAME


'Set the structure size


OFName.lStructSize = Len(OFName)


'Set the owner window


OFName.hwndOwner = 0


'Set the filter


OFName.lpstrFilter = Filter


'Set the maximum number of chars


OFName.nMaxFile = 255


'Create a buffer


OFName.lpstrFile = Space(254)


'Create a buffer


OFName.lpstrFileTitle = Space$(254)


'Set the maximum number of chars


OFName.nMaxFileTitle = 255


'Set the initial directory


OFName.lpstrInitialDir = InitialDir


'Set the dialog title


OFName.lpstrTitle = DialogTitle


'no extra flags


OFName.flags = 0


'Show the 'Open File' dialog


If GetOpenFileName(OFName) Then


ShowOpen = Trim(OFName.lpstrFile)


Else


ShowOpen = ""


End If


End Function





'---------------------------------------------------------------'


Function IsExcelRunning() As Boolean


Dim xlApp As Excel.Application


On Error Resume Next


Set xlApp = GetObject(, "Excel.Application")


IsExcelRunning = (Err.Number = 0)


Set xlApp = Nothing


Err.Clear


End Function





Sub CreateDxfDocuments()


' To read data from specific Excel range


Dim xlApp As Excel.Application


Dim blnIsOK As Boolean


Dim xlBook As Excel.Workbook


Dim xlSheet As Excel.Worksheet


blnIsOK = IsExcelRunning()


If blnIsOK Then


Set xlApp = GetObject(, "Excel.Application")


Else


Set xlApp = CreateObject("Excel.Application")


xlApp.Visible = True


xlApp.UserControl = True


End If


Dim xlFileName As String


Dim Filter As String


Dim InitialDir As String


Dim DialogTitle As String





Filter = "Excel Files (*.xlsx)" + Chr$(0) + "*.xlsx" + Chr$(0) + _


"All Files (*.*)" + Chr$(0) + "*.*" + Chr$(0)


InitialDir = ThisDrawing.GetVariable("dwgprefix")


DialogTitle = "Open an Excel file"


xlFileName = ShowOpen(Filter, InitialDir, DialogTitle)


' to avoid using code above try hard coded file path,


' set full path of your Excel file here:


' xlFileName = "C:\Users\User\myxlFile.xlsx"


xlApp.Application.ScreenUpdating = False


' open file for read


Set xlBook = xlApp.Workbooks.Open(xlFileName)


Set xlSheet = xlBook.Worksheets("Sheet1") ' desired sheet name , same if use 
xlBook.Worksheets(1)


xlSheet.Activate


Dim xlrange As Excel.Range


Set xlrange = xlSheet.Range("A1:H4") ' range address we interested in


xlrange.Select


   Dim cols As Long


   Dim rows As Long


   cols = xlrange.Columns.Count


   rows = xlrange.rows.Count


Dim rangeValue As Variant


rangeValue = xlrange.Value2


' clean up memory


   xlBook.Close False


 Set xlBook = Nothing


   xlApp.Quit


 Set xlApp = Nothing


 'DoEvents





' end of work with Excel,


' go to Autocad then


MsgBox "Back to AutoCAD"


''--------------------------------------------------------


Dim dxfname As String


dxfname = "-Sample.dxf"


Dim ptCoordinates As New Collection


  Dim i, j


  For i = LBound(rangeValue, 1) To UBound(rangeValue, 1)


  ReDim ptarray(LBound(rangeValue, 2) To UBound(rangeValue, 2)) As 
Double


  For j = LBound(rangeValue, 2) To UBound(rangeValue, 2)


  ptarray(j) = rangeValue(i, j)


  Next j


  ptCoordinates.Add ptarray, CStr(i) & dxfname


  Next i


  Dim docMgr As AcadDocuments


  Set docMgr = Application.Documents





Dim item As Variant


Dim num As Integer


num = 1


For Each item In ptCoordinates


Dim acDoc As AcadDocument


ReDim dblPoints(LBound(item) To UBound(item)) As Double


For i = LBound(item) To UBound(item)


dblPoints(i) = CDbl(item(i))


Next i


Set acDoc = docMgr.Add()


Dim lwPoly As AcadLWPolyline


Set lwPoly = acDoc.ModelSpace.AddLightWeightPolyline(dblPoints)


lwPoly.Closed = True


acDoc.Application.ZoomExtents


acDoc.SaveAs ThisDrawing.GetVariable("dwgprefix") & CStr(num) & 
dxfname, ac2007_dxf


acDoc.Close


num = num + 1


Next item


MsgBox "Done"


End Sub


'---------------------------------------------------------------'

Edited July 19, 2013 by fixo
code added

[snglvl]

This is the screen shot of the file.

 

 

Please, attach a screenshot of Excel file for test,

it's not clearly enough how is your data filled in there

Say if your coordinates in 8 columns per even row,

try this example

Option Explicit


'---------------------------------------------------------------'


' Notes:


' 1. requires settings: Tools -> Options -> General tab -> Error 
trapping field -> check "Break on Unhandled errors"


' 2. requires reference to Microsoft Excel XX.0 Object Library


'---------------------------------------------------------------'


' written by Sccadmember


' Date: Aug/04/06


' [url]http://discussion.autodesk.com/thread.jspa?threadID=489202[/url]


' Just thought I would post this because I have been looking for a working 
VBA file open dialog box


' solution for awhile. 'I'm an old autolisped making the jump to VBA and I 
have seen and read


' various solutons for the equivalent getfiled 'autolisp function but I never 
had much luck with them.


' This one worked for me it uses the Win API to do the job.


'---------------------------------------------------------------'


Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _


"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long


Private Type OPENFILENAME


lStructSize As Long


hwndOwner As Long


hInstance As Long


lpstrFilter As String


lpstrCustomFilter As String


nMaxCustFilter As Long


nFilterIndex As Long


lpstrFile As String


nMaxFile As Long


lpstrFileTitle As String


nMaxFileTitle As Long


lpstrInitialDir As String


lpstrTitle As String


flags As Long


nFileOffset As Integer


nFileExtension As Integer


lpstrDefExt As String


lCustData As Long


lpfnHook As Long


lpTemplateName As String


End Type


'---------------------------------------------------------------'


Public Function ShowOpen(Filter As String, _


InitialDir As String, _


DialogTitle As String) As String


Dim OFName As OPENFILENAME


'Set the structure size


OFName.lStructSize = Len(OFName)


'Set the owner window


OFName.hwndOwner = 0


'Set the filter


OFName.lpstrFilter = Filter


'Set the maximum number of chars


OFName.nMaxFile = 255


'Create a buffer


OFName.lpstrFile = Space(254)


'Create a buffer


OFName.lpstrFileTitle = Space$(254)


'Set the maximum number of chars


OFName.nMaxFileTitle = 255


'Set the initial directory


OFName.lpstrInitialDir = InitialDir


'Set the dialog title


OFName.lpstrTitle = DialogTitle


'no extra flags


OFName.flags = 0


'Show the 'Open File' dialog


If GetOpenFileName(OFName) Then


ShowOpen = Trim(OFName.lpstrFile)


Else


ShowOpen = ""


End If


End Function





'---------------------------------------------------------------'


Function IsExcelRunning() As Boolean


Dim xlApp As Excel.Application


On Error Resume Next


Set xlApp = GetObject(, "Excel.Application")


IsExcelRunning = (Err.Number = 0)


Set xlApp = Nothing


Err.Clear


End Function





Sub CreateDxfDocuments()


' To read data from specific Excel range


Dim xlApp As Excel.Application


Dim blnIsOK As Boolean


Dim xlBook As Excel.Workbook


Dim xlSheet As Excel.Worksheet


blnIsOK = IsExcelRunning()


If blnIsOK Then


Set xlApp = GetObject(, "Excel.Application")


Else


Set xlApp = CreateObject("Excel.Application")


xlApp.Visible = True


xlApp.UserControl = True


End If


Dim xlFileName As String


Dim Filter As String


Dim InitialDir As String


Dim DialogTitle As String





Filter = "Excel Files (*.xlsx)" + Chr$(0) + "*.xlsx" + Chr$(0) + _


"All Files (*.*)" + Chr$(0) + "*.*" + Chr$(0)


InitialDir = ThisDrawing.GetVariable("dwgprefix")


DialogTitle = "Open an Excel file"


xlFileName = ShowOpen(Filter, InitialDir, DialogTitle)


' to avoid using code above try hard coded file path,


' set full path of your Excel file here:


' xlFileName = "C:\Users\User\myxlFile.xlsx"


xlApp.Application.ScreenUpdating = False


' open file for read


Set xlBook = xlApp.Workbooks.Open(xlFileName)


Set xlSheet = xlBook.Worksheets("Sheet1") ' desired sheet name , same if use 
xlBook.Worksheets(1)


xlSheet.Activate


Dim xlrange As Excel.Range


Set xlrange = xlSheet.Range("A1:H4") ' range address we interested in


xlrange.Select


   Dim cols As Long


   Dim rows As Long


   cols = xlrange.Columns.Count


   rows = xlrange.rows.Count


Dim rangeValue As Variant


rangeValue = xlrange.Value2


' clean up memory


   xlBook.Close False


 Set xlBook = Nothing


   xlApp.Quit


 Set xlApp = Nothing


 'DoEvents





' end of work with Excel,


' go to Autocad then


MsgBox "Back to AutoCAD"


''--------------------------------------------------------


Dim dxfname As String


dxfname = "-Sample.dxf"


Dim ptCoordinates As New Collection


  Dim i, j


  For i = LBound(rangeValue, 1) To UBound(rangeValue, 1)


  ReDim ptarray(LBound(rangeValue, 2) To UBound(rangeValue, 2)) As 
Double


  For j = LBound(rangeValue, 2) To UBound(rangeValue, 2)


  ptarray(j) = rangeValue(i, j)


  Next j


  ptCoordinates.Add ptarray, CStr(i) & dxfname


  Next i


  Dim docMgr As AcadDocuments


  Set docMgr = Application.Documents





Dim item As Variant


Dim num As Integer


num = 1


For Each item In ptCoordinates


Dim acDoc As AcadDocument


ReDim dblPoints(LBound(item) To UBound(item)) As Double


For i = LBound(item) To UBound(item)


dblPoints(i) = CDbl(item(i))


Next i


Set acDoc = docMgr.Add()


Dim lwPoly As AcadLWPolyline


Set lwPoly = acDoc.ModelSpace.AddLightWeightPolyline(dblPoints)


lwPoly.Closed = True


acDoc.Application.ZoomExtents


acDoc.SaveAs ThisDrawing.GetVariable("dwgprefix") & CStr(num) & 
dxfname, ac2007_dxf


acDoc.Close


num = num + 1


Next item


MsgBox "Done"


End Sub


'---------------------------------------------------------------'

[snglvl]

Marvel! You are great! Thanks for the reply. It solved the problem.

giving the co-ordinates in 8 successive columns, it worked flawless

 

Two things i want to add,

 

1) How to select the final Directory where the files to be saved.

2) If i have the respective file names in another column, how can i use it?

(i am going to use this to generate some 500 dxf at a time. To reduce the redundancy I need this step)

 

 

Please, attach a screenshot of Excel file for test,

it's not clearly enough how is your data filled in there

Say if your coordinates in 8 columns per even row,

try this example

Option Explicit


'---------------------------------------------------------------'


' Notes:


' 1. requires settings: Tools -> Options -> General tab -> Error 
trapping field -> check "Break on Unhandled errors"


' 2. requires reference to Microsoft Excel XX.0 Object Library


'---------------------------------------------------------------'


' written by Sccadmember


' Date: Aug/04/06


' [url]http://discussion.autodesk.com/thread.jspa?threadID=489202[/url]


' Just thought I would post this because I have been looking for a working 
VBA file open dialog box


' solution for awhile. 'I'm an old autolisped making the jump to VBA and I 
have seen and read


' various solutons for the equivalent getfiled 'autolisp function but I never 
had much luck with them.


' This one worked for me it uses the Win API to do the job.


'---------------------------------------------------------------'


Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _


"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long


Private Type OPENFILENAME


lStructSize As Long


hwndOwner As Long


hInstance As Long


lpstrFilter As String


lpstrCustomFilter As String


nMaxCustFilter As Long


nFilterIndex As Long


lpstrFile As String


nMaxFile As Long


lpstrFileTitle As String


nMaxFileTitle As Long


lpstrInitialDir As String


lpstrTitle As String


flags As Long


nFileOffset As Integer


nFileExtension As Integer


lpstrDefExt As String


lCustData As Long


lpfnHook As Long


lpTemplateName As String


End Type


'---------------------------------------------------------------'


Public Function ShowOpen(Filter As String, _


InitialDir As String, _


DialogTitle As String) As String


Dim OFName As OPENFILENAME


'Set the structure size


OFName.lStructSize = Len(OFName)


'Set the owner window


OFName.hwndOwner = 0


'Set the filter


OFName.lpstrFilter = Filter


'Set the maximum number of chars


OFName.nMaxFile = 255


'Create a buffer


OFName.lpstrFile = Space(254)


'Create a buffer


OFName.lpstrFileTitle = Space$(254)


'Set the maximum number of chars


OFName.nMaxFileTitle = 255


'Set the initial directory


OFName.lpstrInitialDir = InitialDir


'Set the dialog title


OFName.lpstrTitle = DialogTitle


'no extra flags


OFName.flags = 0


'Show the 'Open File' dialog


If GetOpenFileName(OFName) Then


ShowOpen = Trim(OFName.lpstrFile)


Else


ShowOpen = ""


End If


End Function





'---------------------------------------------------------------'


Function IsExcelRunning() As Boolean


Dim xlApp As Excel.Application


On Error Resume Next


Set xlApp = GetObject(, "Excel.Application")


IsExcelRunning = (Err.Number = 0)


Set xlApp = Nothing


Err.Clear


End Function





Sub CreateDxfDocuments()


' To read data from specific Excel range


Dim xlApp As Excel.Application


Dim blnIsOK As Boolean


Dim xlBook As Excel.Workbook


Dim xlSheet As Excel.Worksheet


blnIsOK = IsExcelRunning()


If blnIsOK Then


Set xlApp = GetObject(, "Excel.Application")


Else


Set xlApp = CreateObject("Excel.Application")


xlApp.Visible = True


xlApp.UserControl = True


End If


Dim xlFileName As String


Dim Filter As String


Dim InitialDir As String


Dim DialogTitle As String





Filter = "Excel Files (*.xlsx)" + Chr$(0) + "*.xlsx" + Chr$(0) + _


"All Files (*.*)" + Chr$(0) + "*.*" + Chr$(0)


InitialDir = ThisDrawing.GetVariable("dwgprefix")


DialogTitle = "Open an Excel file"


xlFileName = ShowOpen(Filter, InitialDir, DialogTitle)


' to avoid using code above try hard coded file path,


' set full path of your Excel file here:


' xlFileName = "C:\Users\User\myxlFile.xlsx"


xlApp.Application.ScreenUpdating = False


' open file for read


Set xlBook = xlApp.Workbooks.Open(xlFileName)


Set xlSheet = xlBook.Worksheets("Sheet1") ' desired sheet name , same if use 
xlBook.Worksheets(1)


xlSheet.Activate


Dim xlrange As Excel.Range


Set xlrange = xlSheet.Range("A1:H4") ' range address we interested in


xlrange.Select


   Dim cols As Long


   Dim rows As Long


   cols = xlrange.Columns.Count


   rows = xlrange.rows.Count


Dim rangeValue As Variant


rangeValue = xlrange.Value2


' clean up memory


   xlBook.Close False


 Set xlBook = Nothing


   xlApp.Quit


 Set xlApp = Nothing


 'DoEvents





' end of work with Excel,


' go to Autocad then


MsgBox "Back to AutoCAD"


''--------------------------------------------------------


Dim dxfname As String


dxfname = "-Sample.dxf"


Dim ptCoordinates As New Collection


  Dim i, j


  For i = LBound(rangeValue, 1) To UBound(rangeValue, 1)


  ReDim ptarray(LBound(rangeValue, 2) To UBound(rangeValue, 2)) As 
Double


  For j = LBound(rangeValue, 2) To UBound(rangeValue, 2)


  ptarray(j) = rangeValue(i, j)


  Next j


  ptCoordinates.Add ptarray, CStr(i) & dxfname


  Next i


  Dim docMgr As AcadDocuments


  Set docMgr = Application.Documents





Dim item As Variant


Dim num As Integer


num = 1


For Each item In ptCoordinates


Dim acDoc As AcadDocument


ReDim dblPoints(LBound(item) To UBound(item)) As Double


For i = LBound(item) To UBound(item)


dblPoints(i) = CDbl(item(i))


Next i


Set acDoc = docMgr.Add()


Dim lwPoly As AcadLWPolyline


Set lwPoly = acDoc.ModelSpace.AddLightWeightPolyline(dblPoints)


lwPoly.Closed = True


acDoc.Application.ZoomExtents


acDoc.SaveAs ThisDrawing.GetVariable("dwgprefix") & CStr(num) & 
dxfname, ac2007_dxf


acDoc.Close


num = num + 1


Next item


MsgBox "Done"


End Sub


'---------------------------------------------------------------'

Edited July 21, 2013 by snglvl
Solved myself. actually no problem at all.

[fixo]

On the quick glance you have to use instead of this line:

acDoc.SaveAs ThisDrawing.GetVariable("dwgprefix") & CStr(num) & 


dxfname, ac2007_dxf

the following code block :

Dim myFolder as string   'or save folder as Const in the start of Module


myFolder="C:\Users\User\DxfFolder\


acDoc.SaveAs MyFolder & CStr(num) & 


dxfname, ac2007_dxf

Also as i've seen from your screenshot you can easily calculate

all vertices of rectangle and pass them all into function,

I have not have a time on this work, sorry

Do it by yourself

Cheers

[snglvl]

Oh Thank you sir. You have already given me what i need. I really appreciate your timely help.

I 've figured it out myself.

 

On the quick glance you have to use instead of this line:

acDoc.SaveAs ThisDrawing.GetVariable("dwgprefix") & CStr(num) & 


dxfname, ac2007_dxf

the following code block :

Dim myFolder as string   'or save folder as Const in the start of Module


myFolder="C:\Users\User\DxfFolder\


acDoc.SaveAs MyFolder & CStr(num) & 


dxfname, ac2007_dxf

Also as i've seen from your screenshot you can easily calculate

all vertices of rectangle and pass them all into function,

I have not have a time on this work, sorry

Do it by yourself

Cheers

[antepli]

not work this lisp my auutocad plase hep me

[MSasu]

Antepli, the LT versions (as per you profile) doesn't support AutoLISP, so unfortunately you cannot use the routine.

[antepli]

sorry Visual Basic Code problem this code

[MSasu]

I'm afraid that the answer is the same for Visual Basic code and LT.