从ACAD中绘制矩形
朋友们好，我正在使用AutoCAD 2012。我在Excel工作表（inputList.xlsx）中有一个矩形尺寸列表，我需要在autocad中创建矩形，并将其以dxf格式保存在一个文件夹中，而不实际打开autocad。有人能帮忙吗？？？我有vba在excel方面的知识。。。 欢迎来到CADTutor。对不起，我不能帮你，但如果有人帮你，希望他们能为我写一个，将我的日常工作
没有我的眼睛。
对不起，我忍不住，请耐心等待，可能有人会帮你施展魔法。 您可以通过COM技术访问AutoCAD应用程序：
Set appAutoCAD = CreateObject("AutoCAD.Application")
但是，您可以选择隐藏其界面，但AutoCAD应处于打开状态才能编辑图形。
myDrawing.Application.Visible = False 顺便说一句，最简单的解决方案是从这些坐标系中创建脚本，方法是在Excel中格式化数据或使用VBA自动化，然后在AutoCAD中调用它。
_RECTANGLE 0.0,0.0 10.0,10.0
;end of script 如果在excel中格式化数据，使矩形坐标存储在前4列中。
A列包含第一个x坐标
B列包含第一个y坐标
C列包含第二个x坐标
D列包含第二个y坐标
然后，以下代码将创建一个脚本文件，您可以将其拖动到打开的autocad窗口中
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
您可以根据需要更改文件名，然后需要创建文件夹，将“r”的值更改为您拥有的数据行数。最后一件事是确保关闭所有OSNAP，即使在运行脚本时，如果某个点接近您的坐标，autocad也会捕捉到该点。首先在空白图形文件上测试这一点，并始终在运行脚本之前备份任何图形。
这是使用Excel VBA创建脚本的基础，您可以添加到其中以创建DXF文件，只需计算出命令序列并将其添加到脚本中即可。 这段代码是我在VBA（AutoCAD）中用来创建矩形的
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
但它使用一个用户表单，从用户那里获取数据，数据来自AutoCAD
我需要从Excel和Excel中输入。。。 请阅读代码发布指南并使用代码标签。 请附上测试用Excel文件的截图，
你的数据是如何填写的还不够清楚
假设你的坐标在每偶数行8列中，
试试这个例子
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
' http://discussion.autodesk.com/thread.jspa?threadID=489202
' 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
'---------------------------------------------------------------'
这是文件的屏幕截图。
令人惊异的人你太棒了！谢谢你的回复。它解决了这个问题。
在连续的8列中给出坐标，它工作得完美无缺
我想补充两件事，
1） 如何选择保存文件的最终目录。
2） 如果我在另一列中有相应的文件名，我如何使用它？
（我将使用它一次生成大约500个dxf。为了减少冗余，我需要这一步）
页:
[1]
2