怎样用VBA读取Autocad图中线条端点的坐标
如题 <p>图中的线条对象你打算如何得到？</p><p>手动选择？</p> ’在AutoCAD中编程序，写到c盘根目录下的“123.xls”Excel表格中 <br/>’使用 VBA IDE 中的“工具” “引用”菜单选项，选择 Microsoft Excel 9.0 对象模型 <br/>’水平不高，有点罗嗦，楼主可以精简下 <br/>’欢迎以后交流，QQ 42123043 <br/>Public Sub 取坐标() <br/>’把AutoCAD中某一图层“多段线层”中的所有多段线的坐标列出来 <br/>Dim PLSet As AcadSelectionSet <br/>Dim pl As AcadLWPolyline <br/><br/><br/>Dim ExcelApp As Excel.Application <br/>Dim ExcelSheet As Object <br/>Dim ExcelWorkbook As Object <br/><br/><br/>Dim pts As Variant <br/><br/>Dim NN As Integer <br/>Dim j As Integer <br/><br/>Dim pn As Integer <br/><br/>Dim px(0 To 10000) As Double <br/>Dim py(0 To 10000) As Double <br/>Dim pz(0 To 10000) As Double <br/><br/><br/>Dim filtertype(10) As Integer <br/>Dim filterdata(1) As Variant <br/><br/>filtertype(0) = 0 ’ 选择线型 <br/>filterdata(0) = "LWPOLYLINE" <br/>filtertype(1) = 8 ’ 图层标识，可以根据具体情况改动 <br/>filterdata(1) = "多段线层" <br/><br/><br/><br/>Set PLSet = ThisDrawing.SelectionSets.Add("pl") <br/>PLSet.SelectOnScreen filtertype, filterdata <br/><br/>NN = 0 <br/>j = 0 <br/>For Each pl In PLSet <br/><br/>pts = pl.Coordinates <br/>pn = (UBound(pts) + 1) / 2 <br/><br/>For i = 0 To pn - 1 <br/>px(i + pn * j) = pts(2 * i) <br/>py(i + pn * j) = pts(2 * i + 1) <br/>Next i <br/>j = j + 1 <br/>NN = NN + pn <br/>Next pl <br/><br/>PLSet.Delete <br/><br/><br/>Set ExcelApp = New Excel.Application <br/><br/>Set ExcelWorkbook = ExcelApp.Workbooks.Add <br/><br/>Set ExcelSheet = ExcelApp.ActiveSheet <br/><br/>ExcelWorkbook.SaveAs "c:\123.xls" <br/><br/>ExcelSheet.Cells(1, 1) = "x" <br/>ExcelSheet.Cells(1, 2) = "y" <br/><br/>For i = 0 To NN - 1 <br/>ExcelSheet.Cells(i + 2, 1) = px(i) <br/>ExcelSheet.Cells(i + 2, 2) = py(i) <br/>Next i <br/><br/>End Sub 很好的一个思路，可惜速读很慢，感谢3楼。 <p>不要写EXCEL</p><p>写TXT，速度应还是可以的</p>
页:
[1]