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

koutx

折腾了不知多少遍，也按版主推荐的搜了一些参考资料（Autocad_VBA初级教程、AutoCAD_VBA属性）等等就是没找到附录C，可无奈实在太菜，总也不能完全试通版主48楼这段程序。现在是内部点选没问题了，但是在中间筛选统计部分无论如何也想不出办法来。
- A, ?7 P1 c0 e+ M: [! j: JFor Each LP In SS '遍历选择集，检查多段线是否是矩形并统计结果
            LP.Highlight (False) '被高亮显示的多段线取消高亮
7 E1 N, [4 \# V) V7 M; y- O& T, B            '中间检查、统计部分省略
9 \+ ]- s/ y+ \) o: _: a             .......................
/ `+ k; |- f8 ^& \0 {                         ........................
# c! D3 C# j* ^# I                         ..........................
% A: }0 H! B2 d2 c/ `. |# yNext
在循环中间，怎么也试不通。用LP.Length可得到周长；用LP.Area可得到面积，可就是得不到长、宽。难道要把原先那判断水平线与垂直线交点的整段代码全搬过来吗？可又觉得光靠生硬的搬过来又不行，因为我把矩形数组那一段搬过来试了多少次都不成呀，把P1,P2,P3,P4那一段也搬过来又不知如何给P赋值。无奈知识太少怎么也解决不了啊，请版主百忙中再予指导。多谢了。因为总想多试几种方法比较比较。

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

woaishuijia

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

LWPOLYLINE（优化多段线）对象有下面两个属性和方法可以用来在本程序中判断是否矩形
' V& v4 d& v  L( E4 P/ o一、Coordinates属性。可读写。读取时的语法是
5 M) K7 k- i* HV=PL.Coordinates
其中，V在使用前应声明为变体型变量（Variant），它返回一个双精度数组，包含优化多段线全部顶点的二维坐标。对于矩形，应该返回一个8元素的双精度数组，元素分别为第1个顶点X坐标、第1个顶点Y坐标、第2个顶点X坐标、第2个顶点Y坐标。。。。。。依此类推。
) Z" T  f$ _3 c& j1 L二、GetBulge方法。只读，语法是
- S& X  |  z3 r/ {D=PL.GetBulge(Index)
$ }; w5 p$ E9 T其中，Index是多段线顶点索引，第1个顶点索引是0，第2个是1。。。。依此类推。D是双精度变量（Double），它返回指定顶点与下一个顶点间的线的凸度，如果是0，则为直线；否则是圆弧，该值是该圆弧的圆周角的四分之一的正切值。假如是个逆时针的半圆弧，圆周角是180度，四分之一就是45度，45度的正切值是1，也就是说，如果返回值是1，就说明这段线是个逆时针半圆弧。
4 d) V7 G+ \0 L. V4 S
4 W8 A! G- F! a使用上面两个属性和方法，只要你的平面几何知识不是太差，应该能够在本程序中判断得到的多段线是否是矩形吧？
要注意的是，由于计算机浮点运算精度的原因，即使我们的图画得很准确，计算结果也会与理论结果存在些差异，所以在条件判断时要宽容些，只要在一定的范围内就可以了，就像我在三楼的代码一样，要给出一个精度范围。
1 E0 G4 S, U: o; K) j: I( X
/ U. _, t- C( c9 b另外给你一个资料。CAD帮助文件中，开发人员帮助的《ActiveX and VBA Reference》对使用VBA的人来说非常重要，但它是英文版的，很多人看着不方便，下面的附件是中文翻译版本。

: {5 V: c0 u/ o/ I1 Q2 `[ 本帖最后由 woaishuijia 于 2009-3-15 21:32 编辑 ]

koutx

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

koutx

多谢版主详尽的指导和提供的学习资料，受益颇多。
$ F0 c3 n9 w, N7 s% L5 X这些天总是想在版主49楼的方法中再完善一下，可总不能实现，无奈再次请教：
6 x+ H" }8 F" l- |9 w! G问题见下面程序中括号内的标注:
------------------------------------------------------------------------------------------------------------------------
# A4 g2 o( F/ v& ~( j1 QACAD的VBA并没有提供“孤岛检测”的方法，不过可以照下面的调用图形界面的“边界”命令实现它。
  r/ W( b+ k7 l8 z; S0 A- u, fDim I As Integer, SS As AcadSelectionSet, FT(0) As Integer, FD(0) As Variant, P As Variant, LP As AcadLWPolyline
+ p7 q) h& l4 N1 p) h- i: ^, ]    With ThisDrawing
. d* h" U  L* D- }4 ~  d; g" ]        On Error Resume Next
0 J! I0 E5 A( H        Set SS = .SelectionSets.Add("SS" )
( A0 u& |! z: o2 |+ ~        FD(0) = "lwpolyline"
0 W6 ]1 J) w* h+ q- `9 q        Do
$ y) k) p7 R9 s6 o            P = .Utility.GetPoint(, vbCrLf & "拾取内部点:")
: F' W7 ~- [8 O+ Z) _" q0 m            If Err Then Exit Do
* [, z  I" u+ |; m9 k0 I! u& q+ m9 t            .SendCommand "-boundary " & P(0) & "," & P(1) & "  "
            SS.Select acSelectionSetLast, , , FT, FD
# F) ]+ r8 B" s7 _# P: l            If SS.Count = I Then
  {: }; |0 w+ Q! k% \/ A- M( _# b, X                .SendCommand "n "
                Exit Do
2 E( Z, Q; k6 T: R  t            Else
                SS.Item(I).Highlight (True) '选择集的最后一个元素即新创建的多段线用高亮显示
$ {$ O2 F: ~$ m9 p# x* t                  （请问在此处能实现将点击的图形，填充图案或填充底色的语句）
" z3 X1 `0 S! z5 E# W+ K2 |                I = I + 1
! s8 f1 l6 u! @5 t            End If
        Loop
: W9 I" W7 }' L5 i$ V' k
8 d4 q# Q$ `4 ]6 F1 C& D/ y[ 本帖最后由 koutx 于 2009-4-11 14:10 编辑 ]