明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1467|回复: 2

封闭对象里选取一点直接求取面积的问题?

[复制链接]
发表于 2005-4-25 23:42:00 | 显示全部楼层 |阅读模式
< class=MsoPlainText>有以下的VBA代码,目的是在CAD图形的一个封闭对象里选取一点用来直接求取该封闭图形的面积:<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p></o:p>


< class=MsoPlainText>Sub Ar()<o:p></o:p>


< class=MsoPlainText>Dim P0 As Variant                                                 '用户指定的图斑内点<o:p></o:p>


< class=MsoPlainText>Dim PlineObj As AcadLWPolyline                                                                         '边界曲线<o:p></o:p>


< class=MsoPlainText>Dim Area As Double                                                                                                                                                                         '面积<o:p></o:p>


< class=MsoPlainText>Dim X() As Double, Y() As Double                                                         '坐标<o:p></o:p>


< class=MsoPlainText>Dim Pn As Integer, i As Integer<o:p></o:p>


< class=MsoPlainText>Dim PointTmp As Variant


< class=MsoPlainText>0 = ThisDrawing.Utility.GetPoint(, "请在图斑内指定一点")                                                                                         '得到图斑内一点<o:p></o:p>


< class=MsoPlainText>ThisDrawing.SendCommand ("-boundary" &amp; P0(0) &amp; "," &amp; P0(1) &amp; "")                                 '创建边界<o:p></o:p>


< class=MsoPlainText>        <o:p></o:p>


< class=MsoPlainText><U>Set PlineObj = ThisDrawing.ModelSpace.Item(ThisDrawing.ModelSpace.Count - 1)                                                         '边界线对象<o:p></o:p></U>


< class=MsoPlainText>        <o:p></o:p>


< class=MsoPlainText>Area = PlineObj.Area                                                                                                                                                                                                                         '面积<o:p></o:p>


< class=MsoPlainText>n = (UBound(PlineObj.Coordinates) + 1) / 2                                         '点数<o:p></o:p>


< class=MsoPlainText>ReDim X(1 To Pn), Y(1 To Pn)<o:p></o:p>


< class=MsoPlainText>For i = 1 To Pn<o:p></o:p>


< class=MsoPlainText>                         PointTmp = PlineObj.Coordinate(i - 1)<o:p></o:p>


< class=MsoPlainText>                         X(i) = PointTmp(1)                                                                         'X坐标<o:p></o:p>


< class=MsoPlainText>                         Y(i) = PointTmp(0)                                                                         'Y坐标<o:p></o:p>


< class=MsoPlainText>Next i<o:p></o:p>


< class=MsoPlainText>End Sub<o:p></o:p>


< class=MsoPlainText>        <o:p></o:p>

但每次运行总发生运行时错误13’类型不匹配(在'边界线对象行),请教大虾:究竟有什么不妥?会否和程序的版本有关?我用的是CAD2002迷你版。
发表于 2005-4-26 12:30:00 | 显示全部楼层
出现错误的是这条语句:
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字符。
发表于 2005-5-2 10:11:00 | 显示全部楼层
依然会有错误,每次逐行运行不会产生这个错误13’类型不匹配,但是总体运行时便会产生,这个是不是和sendcommand语句有关,根据设置断点等方法后发现,只有在完全退出程序后vba才能识别出刚才产生的多样线,(当然逐语句运行不会有错)。请各位高手解答,谢谢。


ps:sendcommand最好修改为


ThisDrawing.SendCommand "-boundary" &amp; vbCr &amp; "a" &amp; vbCr &amp; "o" &amp;vbCr &amp; "p" &amp; vbCr &amp; vbCr &amp; CStr(P0(0)) &amp; "," &amp; CStr(P0(1)) &amp; vbCr &amp; vbCr


用来保证创建的是多样线,不然有可能创建的会是面域(默认选项不定)
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-11-27 17:53 , Processed in 0.167259 second(s), 24 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表