Question

CADVBA直线和多段线如何更改代码

Dim xlapp As Excel.Application
Dim xlbook As Excel.Workbook
Dim xlsheet As Excel.worksheet
Sub hdmht() '宏名
Set xlapp = CreateObject("excel.application")
Set xlbook = xlapp.workbooks.Open("C:\Users\ASUS\Desktop\学习.xlsx") '打开的EXCEL路径
xlapp.Visible = False
Set xlsheet = xlbook.worksheets("sjx") '打开EXCEL中的工作表
i = xlsheet.Cells(9, 69) 'i为点数
For p = 0 To i - 3 Step 1 '开始循环
p = p
k1 = xlsheet.Cells(15, 4 + p) '这里表示第2行第4列
h1 = xlsheet.Cells(16, 4 + p)
k2 = xlsheet.Cells(15, 5 + p) '这里表示第3行第5列
h2 = xlsheet.Cells(16, 5 + p)
Dim 点 As AcadLine
Dim 起点(2) As Double
Dim 端点(2) As Double
起点(0) = k1
起点(1) = h1
端点(0) = k2
端点(1) = h2
Set 点 = ThisDrawing.ModelSpace.AddLine(起点, 端点)
Next
ZoomExtents '缩放至满幅
xlbook.Close
xlapp.Quit
Set xlapp = Nothing
End Sub
如何更改代码！使得绘出的线段为多段线！求高手解答！

Answer 1

绘制多段线的VBA方法是AddPolyline，它包含一个VerticesList参数（顶点列表）。

1、其参数必须声明为一个Double类型的一维数组。

当多段线的全部顶点的个数为n(n>=2）时，该数组元素的个数为3n，其顺序包含每个顶点的x、y坐标值和前进方向（弧度）。

2、由于多段线至少要有2个顶点，所以该数组的元素总个数至少为6，而且是必须是3的倍数，否则都不会被ACAD所接受。

 

某篇论文中（http://www.xzbu.com/2/view-564089.htm），对于用VBA绘制多段线，采用了非常繁琐的方法，可能就是因为对该方法的参数要求没有掌握清楚的原因。

 

实际上，我们只要按前述2点要求声明参数类型，并正确赋值，就能够一次性绘制出整条多段线。

Sub Example_AddPolyLine()
    Dim xyz() As Double
    n = 6 '顶点个数
    ReDim xyz(0 To 3 * n - 1)
    xyz(0) = 4: xyz(1) = 7: xyz(2) = 0  
    xyz(3) = 5: xyz(4) = 7: xyz(5) = 0
    xyz(6) = 6: xyz(7) = 7: xyz(8) = 0
    xyz(9) = 4: xyz(10) = 6: xyz(11) = 0
    xyz(12) = 5: xyz(13) = 6: xyz(14) = 0
    xyz(15) = 6: xyz(16) = 6: xyz(17) = 0
    Set mLineObj = ThisDrawing.ModelSpace.AddPolyline(xyz)
    ThisDrawing.Application.ZoomAll
    MsgBox "A new PolyLine has been added to the drawing"
End Sub