封闭对象里选取一点直接求取面积的问题?
< class=MsoPlainText>有以下的VBA代码,目的是在CAD图形的一个封闭对象里选取一点用来直接求取该封闭图形的面积:< class=MsoPlainText>Sub Ar()
< class=MsoPlainText>Dim P0 As Variant '用户指定的图斑内点
< class=MsoPlainText>Dim PlineObj As AcadLWPolyline '边界曲线
< class=MsoPlainText>Dim Area As Double '面积
< class=MsoPlainText>Dim X() As Double, Y() As Double '坐标
< class=MsoPlainText>Dim Pn As Integer, i As Integer
< class=MsoPlainText>Dim PointTmp As Variant
< class=MsoPlainText>0 = ThisDrawing.Utility.GetPoint(, "请在图斑内指定一点") '得到图斑内一点
< class=MsoPlainText>ThisDrawing.SendCommand ("-boundary" & P0(0) & "," & P0(1) & "") '创建边界
< class=MsoPlainText>
< class=MsoPlainText>Set PlineObj = ThisDrawing.ModelSpace.Item(ThisDrawing.ModelSpace.Count - 1) '边界线对象
< class=MsoPlainText>
< class=MsoPlainText>Area = PlineObj.Area '面积
< class=MsoPlainText>n = (UBound(PlineObj.Coordinates) + 1) / 2 '点数
< class=MsoPlainText>ReDim X(1 To Pn), Y(1 To Pn)
< class=MsoPlainText>For i = 1 To Pn
< class=MsoPlainText> PointTmp = PlineObj.Coordinate(i - 1)
< class=MsoPlainText> X(i) = PointTmp(1) 'X坐标
< class=MsoPlainText> Y(i) = PointTmp(0) 'Y坐标
< class=MsoPlainText>Next i
< class=MsoPlainText>End Sub
< class=MsoPlainText>
但每次运行总发生运行时错误13’类型不匹配(在'边界线对象行),请教大虾:究竟有什么不妥?会否和程序的版本有关?我用的是CAD2002迷你版。 出现错误的是这条语句:
ThisDrawing.SendCommand ("-boundary" & P0(0) & "," & P0(1) & "") '创建边界
应当注意到SendCommand的定义格式为:object.SendCommand(Command as String)
应该修改为:
ThisDrawing.SendCommand "-boundary" & vbCr & CStr(P0(0)) & "," & CStr(P0(1)) & vbCr & vbCr
注意:在Command的尾部应当加两个vbCr字符。 依然会有错误,每次逐行运行不会产生这个错误13’类型不匹配,但是总体运行时便会产生,这个是不是和sendcommand语句有关,根据设置断点等方法后发现,只有在完全退出程序后vba才能识别出刚才产生的多样线,(当然逐语句运行不会有错)。请各位高手解答,谢谢。
ps:sendcommand最好修改为
ThisDrawing.SendCommand "-boundary" & vbCr & "a" & vbCr & "o" &vbCr & "p" & vbCr & vbCr & CStr(P0(0)) & "," & CStr(P0(1)) & vbCr & vbCr
用来保证创建的是多样线,不然有可能创建的会是面域(默认选项不定)
页:
[1]