CAD二次开发对二维图某些数据的统计(请我爱谁家版主再指导)

koutx · 发表于 2009-3-15 20:13:43

折腾了不知多少遍，也按版主推荐的搜了一些参考资料（Autocad_VBA初级教程、AutoCAD_VBA属性）等等就是没找到附录C，可无奈实在太菜，总也不能完全试通版主48楼这段程序。现在是内部点选没问题了，但是在中间筛选统计部分无论如何也想不出办法来。
For Each LP In SS '遍历选择集，检查多段线是否是矩形并统计结果
         LP.Highlight (False) '被高亮显示的多段线取消高亮
         '中间检查、统计部分省略
         .......................
                     ........................
                     ..........................
Next
在循环中间，怎么也试不通。用LP.Length可得到周长；用LP.Area可得到面积，可就是得不到长、宽。难道要把原先那判断水平线与垂直线交点的整段代码全搬过来吗？可又觉得光靠生硬的搬过来又不行，因为我把矩形数组那一段搬过来试了多少次都不成呀，把P1,P2,P3,P4那一段也搬过来又不知如何给P赋值。无奈知识太少怎么也解决不了啊，请版主百忙中再予指导。多谢了。因为总想多试几种方法比较比较。

[ 本帖最后由 koutx 于 2009-3-15 20:15 编辑 ]

woaishuijia · 发表于 2009-3-15 21:17:24

我连书名都告诉你了，为什么不用页面上面的“搜索”，用书名做关键词搜一下有关的帖子呢？
还是把链接给你吧
http://www.3dportal.cn/discuz/viewthread.php?tid=199860&page=1&fromuid=150055#pid960894

LWPOLYLINE（优化多段线）对象有下面两个属性和方法可以用来在本程序中判断是否矩形
一、Coordinates属性。可读写。读取时的语法是
V=PL.Coordinates
其中，V在使用前应声明为变体型变量（Variant），它返回一个双精度数组，包含优化多段线全部顶点的二维坐标。对于矩形，应该返回一个8元素的双精度数组，元素分别为第1个顶点X坐标、第1个顶点Y坐标、第2个顶点X坐标、第2个顶点Y坐标。。。。。。依此类推。
二、GetBulge方法。只读，语法是
D=PL.GetBulge(Index)
其中，Index是多段线顶点索引，第1个顶点索引是0，第2个是1。。。。依此类推。D是双精度变量（Double），它返回指定顶点与下一个顶点间的线的凸度，如果是0，则为直线；否则是圆弧，该值是该圆弧的圆周角的四分之一的正切值。假如是个逆时针的半圆弧，圆周角是180度，四分之一就是45度，45度的正切值是1，也就是说，如果返回值是1，就说明这段线是个逆时针半圆弧。

使用上面两个属性和方法，只要你的平面几何知识不是太差，应该能够在本程序中判断得到的多段线是否是矩形吧？
要注意的是，由于计算机浮点运算精度的原因，即使我们的图画得很准确，计算结果也会与理论结果存在些差异，所以在条件判断时要宽容些，只要在一定的范围内就可以了，就像我在三楼的代码一样，要给出一个精度范围。

另外给你一个资料。CAD帮助文件中，开发人员帮助的《ActiveX and VBA Reference》对使用VBA的人来说非常重要，但它是英文版的，很多人看着不方便，下面的附件是中文翻译版本。

[ 本帖最后由 woaishuijia 于 2009-3-15 21:32 编辑 ]

koutx · 发表于 2009-3-17 14:34:55

谢谢版主提供的资料，问题基本解决了。只是一个一个的点选有点过于麻烦了。

koutx · 发表于 2009-4-11 12:19:44

多谢版主详尽的指导和提供的学习资料，受益颇多。
这些天总是想在版主49楼的方法中再完善一下，可总不能实现，无奈再次请教：
问题见下面程序中括号内的标注:
------------------------------------------------------------------------------------------------------------------------
ACAD的VBA并没有提供“孤岛检测”的方法，不过可以照下面的调用图形界面的“边界”命令实现它。
Dim I As Integer, SS As AcadSelectionSet, FT(0) As Integer, FD(0) As Variant, P As Variant, LP As AcadLWPolyline
With ThisDrawing
      On Error Resume Next
      Set SS = .SelectionSets.Add("SS" )
      FD(0) = "lwpolyline"
      Do
         P = .Utility.GetPoint(, vbCrLf & "拾取内部点:")
         If Err Then Exit Do
         .SendCommand "-boundary " & P(0) & "," & P(1) & "  "
         SS.Select acSelectionSetLast, , , FT, FD
         If SS.Count = I Then
            .SendCommand "n "
            Exit Do
         Else
            SS.Item(I).Highlight (True) '选择集的最后一个元素即新创建的多段线用高亮显示
               （请问在此处能实现将点击的图形，填充图案或填充底色的语句）
            I = I + 1
         End If
      Loop

[ 本帖最后由 koutx 于 2009-4-11 14:10 编辑 ]

		自动登录	找回密码
密码			注册

通知

[已解决] CAD二次开发对二维图某些数据的统计(请我爱谁家版主再指导)

浏览过的版块