VBA用于轮廓重建

[xuminuestc]

AutoCAD VBA根据图像数据重建轮廓模型。
通过MATLAB程序生成一个图像轮廓，保存轮廓数据之后使用AutoCADVBA来重建模型。但运行之后一直报错 ：
运行之后提示错误：

困扰四个月了，四处寻找一直无果。
求大神！

Sub QSGS()
Open "D:\Matlab\R2012b\work\QSGS\porous.txt" For Input As #1
Input #1, Sumpoints:
'Inout #1 means read single char
ReDim points(0 To Sumline * 3 - 1) As Double
'line here means row
Dim plineObj As AcadPolyline
npoints = 0
For i = 1 To Sumpoints 'Loop through all points
Input #1, x, y 'get coordinate of x,y
points(npoints) = x 'x coordinate of point i
points(npoints + 1) = y 'y coordinate of point i
points(npoints + 2) = 0 'z coordinate of point i
npoints = npoints + 3
Next i
Set plineObj = ThisDrawing.ModelSpace.AddPolyline(points)
ZoomAll
Close
End Sub

资料来源：
李仁民等，采用随机生长四参数生成法构造黏土微观结构

[笨狗先飞]

运行一下这个代码， 如果弹出的是“位置一，Sumline<=0！” 你要检查一下Sumline的初始值，这个值不在你这个函数里，当值小于等于0的时候会报错 如果弹出的是“位置二，i的取值过大，检查一下 1~Sumpoints是不是正确！” 你要注意一下你的For循环， For i = 1 To Sumpoints 这里的Sumpoints 的值也没有给明Sumpoints 和 Sumline 之间的关系值是不是对

Sub QSGS()
 Open "D:\Matlab\R2012b\work\QSGS\porous.txt" For Input As #1
 Input #1, Sumpoints:
 'Inout #1 means read single char
if Sumline<=0 then msgbox "位置一，Sumline<=0！" '
 ReDim points(0 To Sumline* 3 - 1) As Double
 'line here means row
 Dim plineObj As AcadPolyline
 npoints = 0
 For i = 1 To Sumpoints 'Loop through all points
 Input #1, x, y 'get coordinate of x,y
 if npoints+2>ubound(points) then msgbox “位置二，i的取值过大，检查一下 1~Sumpoints是不是正确！” & vbcrlf & "Sumpoints=" & cstr(Sumpoints) & "  ,  Sumline="& cstr(Sumline) &"  这两个数据的关系应该不对。"
 points(npoints) = x 'x coordinate of point i
 points(npoints + 1) = y 'y coordinate of point i
 points(npoints + 2) = 0 'z coordinate of point i
 npoints = npoints + 3
 Next i
 Set plineObj = ThisDrawing.ModelSpace.AddPolyline(points)
 ZoomAll
 Close
 End Sub

[笨狗先飞]

引号打错了，免得你说运行报错，我自己改了

Sub QSGS()
 Open "D:\Matlab\R2012b\work\QSGS\porous.txt" For Input As #1
 Input #1, Sumpoints:
 'Inout #1 means read single char
if Sumline<=0 then msgbox "位置一，Sumline<=0！" '
 ReDim points(0 To Sumline* 3 - 1) As Double
 'line here means row
 Dim plineObj As AcadPolyline
 npoints = 0
 For i = 1 To Sumpoints 'Loop through all points
 Input #1, x, y 'get coordinate of x,y
 if npoints+2>ubound(points) then msgbox "位置二，i的取值过大，检查一下 1~Sumpoints是不是正确！" & vbcrlf & "Sumpoints=" & cstr(Sumpoints) & "  ,  Sumline="& cstr(Sumline) &"  这两个数据的关系应该不对。"
 points(npoints) = x 'x coordinate of point i
 points(npoints + 1) = y 'y coordinate of point i
 points(npoints + 2) = 0 'z coordinate of point i
 npoints = npoints + 3
 Next i
 Set plineObj = ThisDrawing.ModelSpace.AddPolyline(points)
 ZoomAll
 Close
 End Sub

[xuminuestc]

引用 1 楼 bakw 的回复:

运行一下这个代码， 如果弹出的是“位置一，Sumline<=0！” 你要检查一下Sumline的初始值，这个值不在你这个函数里，当值小于等于0的时候会报错 如果弹出的是“位置二，i的取值过大，检查一下 1~Sumpoints是不是正确！” 你要注意一下你的For循环， For i = 1 To Sumpoints 这里的Sumpoints 的值也没有给明Sumpoints 和 Sumline 之间的关系值是不是对

Sub QSGS()
 Open "D:\Matlab\R2012b\work\QSGS\porous.txt" For Input As #1
 Input #1, Sumpoints:
 'Inout #1 means read single char
if Sumline<=0 then msgbox "位置一，Sumline<=0！" '
 ReDim points(0 To Sumline* 3 - 1) As Double
 'line here means row
 Dim plineObj As AcadPolyline
 npoints = 0
 For i = 1 To Sumpoints 'Loop through all points
 Input #1, x, y 'get coordinate of x,y
 if npoints+2>ubound(points) then msgbox “位置二，i的取值过大，检查一下 1~Sumpoints是不是正确！” & vbcrlf & "Sumpoints=" & cstr(Sumpoints) & "  ,  Sumline="& cstr(Sumline) &"  这两个数据的关系应该不对。"
 points(npoints) = x 'x coordinate of point i
 points(npoints + 1) = y 'y coordinate of point i
 points(npoints + 2) = 0 'z coordinate of point i
 npoints = npoints + 3
 Next i
 Set plineObj = ThisDrawing.ModelSpace.AddPolyline(points)
 ZoomAll
 Close
 End Sub

轻拍…… 就是不明白这里的Sumpoints和Sumline是怎么来的。因为看论文里面只给了这么一个程序，得到的porous.txt数据里面也没有数据……

[xiaxuetian3425]

不知你的问题解决没啊

[xuminuestc]

引用 4 楼 xiaxuetian3425 的回复:

不知你的问题解决没啊

没有啊，一直没有弄出来，就放弃了~

[twisted1993]

楼主您好，请问matlab部分的程序您有么 可否加一个qq交流一下870971873