一道VB＋CAD的图形难题

dreamci

求：
  如附件图中所示：由line和arc绘制（非多段线）的多个随机单元格构成的复杂图形中，以已知顶点坐标为第一个点，用VB编程，按照逆时针方向顺序求出每个单元个各个顶点坐标，并求出每个单元个面积，结果写入EXCEL或VB的MSFlexGrid控件中，整个过程不要出现鼠标拾取单元格，要自用运行出结果。

我的思路是：VB编程，用For……next将每个单元格用类似“BO”命令自动创建边界，形成多段线单元格，然后用以下代码获取多段线单元的顶点坐标和面积，输入到EXCEL或VB的MSFlexGrid控件中。
7 S2 o0 Q2 B3 p: i1 F- q
1 w3 ]  U) u7 LFor  顶点号
* y. f, P7 R6 m& S) [       1、创建多段线单元
       2、提取多段线顶点坐标和面积信息
       3、将数据填写进EXCEL或VB的MSFlexGrid控件中
+ I& K0 w1 A* J9 ^/ D next 顶点号
9 ~" U" U2 ~: L0 F
% j& `  x$ i' E! w

% X3 S2 u' P! d$ V/ ^+ B' oFor循环中第三部分代码大致如下：
- j% G5 t$ G% |  s1 J- N'MSFlexGrid1中能列出多段线的坐标（我从网上下载到的源代码）
% C$ D. g" `7 B# F' v! E6 s" b5 V
5 b8 t; o$ ^8 _3 oPrivate Sub cd多段线坐标查询_Click()
'==========================================================
  Dim acadApp As AcadApplication
  Dim ssetObj As AcadSelectionSet
7 K! W6 U( N0 E1 ?$ K2 I- m  On Error Resume Next
& H9 t" _0 N& j$ O3 F) e3 p  Set acadApp = GetObject(, "autoCAD.Application")
2 h+ c1 ]) ]- w; M  U  acadApp.ActiveDocument.SelectionSets("hights").Delete
  Set ssetObj = acadApp.ActiveDocument.SelectionSets.Add("hights")
  AppActivate acadApp.Caption
$ W* B3 y) L5 C1 ?, o  Dim FType(0) As Integer
+ J1 i0 z% M6 V3 @1 i; _" k  Dim FData(0) As Variant
3 s. X' n$ n" k6 b5 e1 l* X$ @  FType(0) = 0
  FData(0) = "line"

( [8 }: v# \9 ~- b2 W7 I) i5 d  
" C+ B+ _0 T0 s; e) e2 j  Dim filterType As Variant
  Dim filterData As Variant
! `# B. r2 Z4 U4 e, |1 t ' filterType = FType
4 F8 [* P" j! [6 [' ~ ' filterData = FData
' ssetObj.Select acSelectionSetAll, , , filterType, filterData
'                                                                                'AppActivate userform1.Caption
'
) a/ P, e) \4 y ' Dim pickedObjs As AcadEntity
' For Each pickedObjs In ssetObj
+ q' L) E) x8 H4 Y. C2 _ '   pickedObjs.Highlight (True)
' Next
$ g3 _: k$ q/ o! M8 V ' ssetObj.Delete


8 H) }0 J/ r  W% R$ A5 U. I7 ~+ @
'==========================================================================================================
1 y# u3 m1 O8 h# w9 V

$ _" t4 C- j% l; ~8 h/ n
& N; X$ w. c6 G
5 C( v6 D& t- k$ K6 ^* I    '安全创建选择集
0 v" K) l: C; ?& k% L    'Dim ssetObj As AcadSelectionSet
; }2 Q8 ~1 f4 K, r( p: f    If Not IsNull(acadApp.ActiveDocument.SelectionSets.Item("Test")) Then
6 k4 V( P7 |; B% X- U2 s) F1 a        Set ssetObj = acadApp.ActiveDocument.SelectionSets.Item("Test")
4 \  F+ a. m! e- O& H* d( u9 ?        ssetObj.Delete
: c& x# J8 j1 X$ M( `% A9 P. {    End If
   
* A% a+ h9 Z  R   
    '创建选择集
; \( ^' E; V. w! r+ b    Set ssetObj = acadApp.ActiveDocument.SelectionSets.Add("Test")
   
    '激活CAD窗口
. M6 V7 U* N& Q9 C- c) p    AppActivate acadApp.Caption
    acadApp.WindowState = acMax
    '提示用户从屏幕选择实体对象，并加入选择集
" r" a5 L) J2 w+ L    ssetObj.SelectOnScreen
    ssetObj.Select acSelectionSetAll  '选择所有曲线
   
    '选择完毕后按回车键或单击右键
    'Dim pickedObjs As AcadEntity
+ N/ b; `% ?4 B( A    Dim retCoord As Variant
    For Each pickedObjs In ssetObj
        retCoord = pickedObjs.Coordinates
  d1 t2 s0 X! L* T        AppActivate Me.Caption
; w: k! Z5 n" Y2 Z8 D        acadApp.WindowState = acMin
4 f9 u- D  c1 |        If TypeOf pickedObjs Is AcadPolyline Or TypeOf pickedObjs Is Acad3DPolyline Then   '普通多义线或3维多段线
            j = (UBound(pickedObjs.Coordinates) + 1) / 3   '多义线的顶点数
4 T' b( Z7 I% W# _2 Q$ U# Q8 A            For i = 0 To j * 3 - 1 Step 3
                    If retCoord(0) = retCoord(j * 3 - 3) And retCoord(1) = retCoord(j * 3 - 2) Then  '闭合时
                        MSFlexGrid1.Rows = j
                    Else   '非闭合时
                        MSFlexGrid1.Rows = j + 1
- H% A$ B' \  u* \$ q                    End If
% I) L6 b1 s  q1 J& _# ^1 ^                    MSFlexGrid1.TextMatrix(i / 3 + 1, 0) = i / 3 + 1
                    MSFlexGrid1.TextMatrix(i / 3 + 1, 2) = Format(retCoord(i) / 1000 * Val(Text比例.Text), "0.000")
2 B' E  s$ x7 F6 F                    MSFlexGrid1.TextMatrix(i / 3 + 1, 1) = Format(retCoord(i + 1) / 1000 * Val(Text比例.Text), "0.000")
6 Y% g# t# B4 m$ `+ o
) ~4 I' x( `) l- c$ ?            Next i
6 N2 Z$ [, v: j( M, {; D1 x        ElseIf TypeOf pickedObjs Is AcadLWPolyline Then   '轻便多义线
            j = (UBound(pickedObjs.Coordinates) + 1) / 2   '多义线的顶点数
) g0 {. G# n+ B            For i = 0 To j * 2 - 1 Step 2
                    If retCoord(0) = retCoord(j * 2 - 2) And retCoord(1) = retCoord(j * 2 - 1) Then '闭合时
9 B# I1 ^) W/ Y7 b' U  z; p                        MSFlexGrid1.Rows = j
; }: |/ U9 a$ W& S' j8 n6 {; {                    Else   '非闭合时
: ~. L: j$ z9 m8 m% N                        MSFlexGrid1.Rows = j + 1
- y$ L, ^* M/ Q5 w- r                    End If
% R5 n. K2 }, y  M. Y" l                    '******MSFlexGrid1中只能列出多段线的坐标******
& e' M3 Q, P6 h% K! H                    '不支持面域
                    MSFlexGrid1.TextMatrix(i / 2 + 1, 0) = i / 2 + 1
6 W9 A# e) k0 K8 ~                    'X坐标
9 C. R2 a6 b; k2 L6 |                    MSFlexGrid1.TextMatrix(i / 2 + 1, 1) = Format(retCoord(i) / 1000 * Val(Text比例.Text), "0.000")         'X
; a& A; v) X+ P% w/ v" a                    'Y坐标
& i1 m# m7 U* h2 @6 D  R                    MSFlexGrid1.TextMatrix(i / 2 + 1, 2) = Format(retCoord(i + 1) / 1000 * Val(Text比例.Text), "0.000")     'Y
                    '面积
                    MSFlexGrid1.TextMatrix(i / 2 + 1, 3) = Format(pickedObjs.Area, "0.000") '面积
                    MSFlexGrid1.Refresh
9 T1 c& F! |' H6 T' ]6 s4 P            Next i
2 F0 w+ _# y( q' M        Else
             MsgBox "您选择的不是多段线！", 64 + vbOKOnly, "地质测量"
             ssetObj.Delete
: }; I+ o1 {8 e! D" L: D) K        End If
        Exit For
    Next
    '删除选择集
    ssetObj.Delete
End Sub

'==========================================================

[ 本帖最后由 dreamci 于 2009-5-21 21:58 编辑 ]

dreamci

没有人能解吗？

seafree101300

注释,需要

a2166692

一点都没明白

kjava

不是说不要那个选择吗？怎么程序里还是有选择的代码？另外我觉得有图例说明才行，不然不知道是什么情况