怎样用VBA读取Autocad图中线条端点的坐标

chnxgd

如题

xxxtttxxx

图中的线条对象你打算如何得到？

手动选择？

hisum

’在AutoCAD中编程序，写到c盘根目录下的“123.xls”Excel表格中
’使用 VBA IDE 中的“工具” “引用”菜单选项，选择 Microsoft Excel 9.0 对象模型
’水平不高，有点罗嗦，楼主可以精简下
’欢迎以后交流，QQ 42123043
Public Sub 取坐标()
’把AutoCAD中某一图层“多段线层”中的所有多段线的坐标列出来
Dim PLSet As AcadSelectionSet
Dim pl As AcadLWPolyline


Dim ExcelApp As Excel.Application
Dim ExcelSheet As Object
Dim ExcelWorkbook As Object


Dim pts As Variant

Dim NN As Integer
Dim j As Integer

Dim pn As Integer

Dim px(0 To 10000) As Double
Dim py(0 To 10000) As Double
Dim pz(0 To 10000) As Double


Dim filtertype(10) As Integer
Dim filterdata(1) As Variant

filtertype(0) = 0 ’ 选择线型
filterdata(0) = "LWPOLYLINE"
filtertype(1) = 8 ’ 图层标识，可以根据具体情况改动
filterdata(1) = "多段线层"



Set PLSet = ThisDrawing.SelectionSets.Add("pl")
PLSet.SelectOnScreen filtertype, filterdata

NN = 0
j = 0
For Each pl In PLSet

pts = pl.Coordinates
pn = (UBound(pts) + 1) / 2

For i = 0 To pn - 1
px(i + pn * j) = pts(2 * i)
py(i + pn * j) = pts(2 * i + 1)
Next i
j = j + 1
NN = NN + pn
Next pl

PLSet.Delete


Set ExcelApp = New Excel.Application

Set ExcelWorkbook = ExcelApp.Workbooks.Add

Set ExcelSheet = ExcelApp.ActiveSheet

ExcelWorkbook.SaveAs "c:\123.xls"

ExcelSheet.Cells(1, 1) = "x"
ExcelSheet.Cells(1, 2) = "y"

For i = 0 To NN - 1
ExcelSheet.Cells(i + 2, 1) = px(i)
ExcelSheet.Cells(i + 2, 2) = py(i)
Next i

End Sub

chnxgd

很好的一个思路，可惜速读很慢，感谢3楼。

fjfhgdwfn

不要写EXCEL

写TXT，速度应还是可以的