一道VB＋CAD的图形难题

dreamci

求：
1 _8 A  \; w3 E# w. Z) `9 p, y  如附件图中所示：由line和arc绘制（非多段线）的多个随机单元格构成的复杂图形中，以已知顶点坐标为第一个点，用VB编程，按照逆时针方向顺序求出每个单元个各个顶点坐标，并求出每个单元个面积，结果写入EXCEL或VB的MSFlexGrid控件中，整个过程不要出现鼠标拾取单元格，要自用运行出结果。
9 J# l- f4 ]9 m+ ^, l
我的思路是：VB编程，用For……next将每个单元格用类似“BO”命令自动创建边界，形成多段线单元格，然后用以下代码获取多段线单元的顶点坐标和面积，输入到EXCEL或VB的MSFlexGrid控件中。
1 T" k, A; [. }
For  顶点号
       1、创建多段线单元
       2、提取多段线顶点坐标和面积信息
       3、将数据填写进EXCEL或VB的MSFlexGrid控件中
next 顶点号

8 E1 M' O% F. P! K, C3 d% p
- i  p: M, B% ~2 R
% a! o5 p# g* W6 h, @& P  _6 IFor循环中第三部分代码大致如下：
'MSFlexGrid1中能列出多段线的坐标（我从网上下载到的源代码）

8 @) [7 [5 R2 B# fPrivate Sub cd多段线坐标查询_Click()
'==========================================================
  Dim acadApp As AcadApplication
  Dim ssetObj As AcadSelectionSet
  On Error Resume Next
3 e9 l1 P9 J/ |  Set acadApp = GetObject(, "autoCAD.Application")
  acadApp.ActiveDocument.SelectionSets("hights").Delete
  Set ssetObj = acadApp.ActiveDocument.SelectionSets.Add("hights")
  |. B! l) v2 T  v3 L  AppActivate acadApp.Caption
# e0 Z% ~. h( }/ A% [  Dim FType(0) As Integer
  Dim FData(0) As Variant
  FType(0) = 0
1 @# A: r7 I" l% j% M/ N/ s* s9 h% c  FData(0) = "line"
; p: [: Z# R6 Z3 n" k% j
  
0 @2 J, K: K9 U6 m0 @* e% h: f% w  Dim filterType As Variant
. t+ ]0 I1 [8 d2 F: }) C% g  Dim filterData As Variant
4 u) H5 m- s% \: o8 {0 @! S ' filterType = FType
' filterData = FData
8 w. i- Q' {4 T& d ' ssetObj.Select acSelectionSetAll, , , filterType, filterData
'                                                                                'AppActivate userform1.Caption
6 F# U  r# }4 ?1 d1 a '
$ W8 m  ^$ B+ ?, k% ~4 v ' Dim pickedObjs As AcadEntity
' For Each pickedObjs In ssetObj
'   pickedObjs.Highlight (True)
' Next
' ssetObj.Delete



4 p3 @' _& G! B% v'==========================================================================================================

9 c3 k9 X6 Y3 d! n& k- p/ `


8 [) I5 q4 _+ V    '安全创建选择集
    'Dim ssetObj As AcadSelectionSet
, U) y* N" `, L) _    If Not IsNull(acadApp.ActiveDocument.SelectionSets.Item("Test")) Then
        Set ssetObj = acadApp.ActiveDocument.SelectionSets.Item("Test")
% S# T( v2 L/ Z- E' ~; s        ssetObj.Delete
    End If
   
. Q% i" J, g  M* P! M" o   
    '创建选择集
    Set ssetObj = acadApp.ActiveDocument.SelectionSets.Add("Test")
1 I" b5 w1 h  Y5 E: A: o# n$ o   
    '激活CAD窗口
; m$ |* f) B. |3 C$ g! I7 w; ~    AppActivate acadApp.Caption
( Q% W/ x- r( R( N9 T; l" w0 r# y    acadApp.WindowState = acMax
    '提示用户从屏幕选择实体对象，并加入选择集
    ssetObj.SelectOnScreen
    ssetObj.Select acSelectionSetAll  '选择所有曲线
   
    '选择完毕后按回车键或单击右键
( C6 q1 l; b9 h9 \+ h    'Dim pickedObjs As AcadEntity
    Dim retCoord As Variant
8 D' `# Z6 B( i' V    For Each pickedObjs In ssetObj
& G+ P6 L. P1 m        retCoord = pickedObjs.Coordinates
+ J& r. X- K5 O        AppActivate Me.Caption
- p" m8 O$ @& M' N- {. r4 U        acadApp.WindowState = acMin
        If TypeOf pickedObjs Is AcadPolyline Or TypeOf pickedObjs Is Acad3DPolyline Then   '普通多义线或3维多段线
            j = (UBound(pickedObjs.Coordinates) + 1) / 3   '多义线的顶点数
            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
) \. k4 h* a+ z/ T# r* |5 T                    Else   '非闭合时
1 s- x0 ]. N* J! O! j& _                        MSFlexGrid1.Rows = j + 1
' f0 G( M) L, l0 Q0 u7 ^                    End If
                    MSFlexGrid1.TextMatrix(i / 3 + 1, 0) = i / 3 + 1
                    MSFlexGrid1.TextMatrix(i / 3 + 1, 2) = Format(retCoord(i) / 1000 * Val(Text比例.Text), "0.000")
                    MSFlexGrid1.TextMatrix(i / 3 + 1, 1) = Format(retCoord(i + 1) / 1000 * Val(Text比例.Text), "0.000")

4 c( t) Z  l$ t            Next i
        ElseIf TypeOf pickedObjs Is AcadLWPolyline Then   '轻便多义线
9 z5 a8 ^) m: ?$ w( m% I            j = (UBound(pickedObjs.Coordinates) + 1) / 2   '多义线的顶点数
7 J1 l/ u6 c- B  l1 Y6 |9 [+ E" @            For i = 0 To j * 2 - 1 Step 2
* f/ w& B4 L+ A2 M9 A8 ?                    If retCoord(0) = retCoord(j * 2 - 2) And retCoord(1) = retCoord(j * 2 - 1) Then '闭合时
                        MSFlexGrid1.Rows = j
                    Else   '非闭合时
6 f6 @) W7 R! \/ e1 C+ j% L                        MSFlexGrid1.Rows = j + 1
                    End If
  g2 V( H" Q* v6 D- a$ a4 t                    '******MSFlexGrid1中只能列出多段线的坐标******
! h: _# @4 J7 S; {                    '不支持面域
                    MSFlexGrid1.TextMatrix(i / 2 + 1, 0) = i / 2 + 1
, X; \0 e9 R0 S1 w; E                    'X坐标
% J% o$ j1 B, k3 G, y! ^# V1 z2 H                    MSFlexGrid1.TextMatrix(i / 2 + 1, 1) = Format(retCoord(i) / 1000 * Val(Text比例.Text), "0.000")         'X
, g9 D3 S' a+ d" y5 P. f2 P" [                    'Y坐标
                    MSFlexGrid1.TextMatrix(i / 2 + 1, 2) = Format(retCoord(i + 1) / 1000 * Val(Text比例.Text), "0.000")     'Y
, m- a/ X# A; k, x                    '面积
: l- @$ L7 a# o; s0 e# B' S/ I1 {                    MSFlexGrid1.TextMatrix(i / 2 + 1, 3) = Format(pickedObjs.Area, "0.000") '面积
6 e: E0 `3 H( T$ n, b  e5 b                    MSFlexGrid1.Refresh
! C; U: r5 I' C/ s: l            Next i
        Else
             MsgBox "您选择的不是多段线！", 64 + vbOKOnly, "地质测量"
/ G" s( S  P1 M# I             ssetObj.Delete
        End If
7 W) `4 x& N% s7 W7 `1 P* y2 R        Exit For
    Next
    '删除选择集
  N+ Y! s2 Y! i  L    ssetObj.Delete
/ W4 m8 n  k+ i- t' Y8 q3 MEnd Sub

, Z) T& N. l6 s# i6 O( ^. {'==========================================================
% i0 t' ]9 S1 ^# |+ |
[ 本帖最后由 dreamci 于 2009-5-21 21:58 编辑 ]

dreamci

没有人能解吗？

seafree101300

注释,需要

a2166692

一点都没明白

kjava

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