一道VB＋CAD的图形难题

dreamci

求：
, o# J7 [6 n" ]  如附件图中所示：由line和arc绘制（非多段线）的多个随机单元格构成的复杂图形中，以已知顶点坐标为第一个点，用VB编程，按照逆时针方向顺序求出每个单元个各个顶点坐标，并求出每个单元个面积，结果写入EXCEL或VB的MSFlexGrid控件中，整个过程不要出现鼠标拾取单元格，要自用运行出结果。
7 w% b- m9 z& @# T3 e2 A
5 S( o( r/ v0 a0 Z+ x0 _% l我的思路是：VB编程，用For……next将每个单元格用类似“BO”命令自动创建边界，形成多段线单元格，然后用以下代码获取多段线单元的顶点坐标和面积，输入到EXCEL或VB的MSFlexGrid控件中。
$ \& `$ E5 ]; i" e2 y" I# L5 d0 d
For  顶点号
       1、创建多段线单元
       2、提取多段线顶点坐标和面积信息
       3、将数据填写进EXCEL或VB的MSFlexGrid控件中
: I) M8 a) c2 s4 f4 T7 Y7 K next 顶点号


% `. v) W$ A- ^! F5 w
For循环中第三部分代码大致如下：
( u0 K. X/ i! V: r0 e! o$ e2 X- F- W+ j'MSFlexGrid1中能列出多段线的坐标（我从网上下载到的源代码）
9 G8 c. u3 g& W
Private Sub cd多段线坐标查询_Click()
'==========================================================
  Dim acadApp As AcadApplication
  Dim ssetObj As AcadSelectionSet
" F$ Q9 z% m" a& v  On Error Resume Next
  Set acadApp = GetObject(, "autoCAD.Application")
  s- x2 m. G& P  acadApp.ActiveDocument.SelectionSets("hights").Delete
  Set ssetObj = acadApp.ActiveDocument.SelectionSets.Add("hights")
  AppActivate acadApp.Caption
0 {& L" O) Q! d  Dim FType(0) As Integer
$ M7 @& P9 _- O! C! a5 K  [4 I+ z8 Q  Dim FData(0) As Variant
  FType(0) = 0
  FData(0) = "line"

  
  Dim filterType As Variant
  Dim filterData As Variant
0 k% [% ?3 t/ M3 ~. e ' filterType = FType
' filterData = FData
' ssetObj.Select acSelectionSetAll, , , filterType, filterData
' w3 `& ^6 h7 s: Y% W$ Z '                                                                                'AppActivate userform1.Caption
2 Y6 ^0 w+ ~$ S# A '
' Dim pickedObjs As AcadEntity
' For Each pickedObjs In ssetObj
'   pickedObjs.Highlight (True)
' Next
* H  [) m- f% s ' ssetObj.Delete
4 q5 {4 k2 w2 \3 I& F4 I+ ]
( q5 ], U! ^# V7 G: |; R

  b8 A* j4 K- s2 I- h& i'==========================================================================================================


0 R! N& l: M% Y; Y2 y4 i% V
) n/ y) p/ i0 z' g! |8 ^
    '安全创建选择集
8 Z) P( w+ o/ ]# y    'Dim ssetObj As AcadSelectionSet
+ g* S1 g$ c2 [. u- M, n. ?5 ~' f    If Not IsNull(acadApp.ActiveDocument.SelectionSets.Item("Test")) Then
8 D! p  n7 e5 z- ]        Set ssetObj = acadApp.ActiveDocument.SelectionSets.Item("Test")
' ~5 D, I" u: I! r2 _" K+ i& i        ssetObj.Delete
    End If
   
8 @( X. K5 i- H8 f$ p0 J   
5 r' r9 Z+ V4 S8 V+ g# k) ^    '创建选择集
    Set ssetObj = acadApp.ActiveDocument.SelectionSets.Add("Test")
7 F4 G+ |) q* x$ t' ?   
    '激活CAD窗口
    AppActivate acadApp.Caption
    acadApp.WindowState = acMax
    '提示用户从屏幕选择实体对象，并加入选择集
    ssetObj.SelectOnScreen
& r* s0 ^! U1 D5 J  _1 N1 U& g9 I    ssetObj.Select acSelectionSetAll  '选择所有曲线
( [5 L( O! z; L+ s, ?( n   
- E! T5 Y6 a' c' d+ D' R    '选择完毕后按回车键或单击右键
    'Dim pickedObjs As AcadEntity
    Dim retCoord As Variant
1 {6 i5 {. V) A: E    For Each pickedObjs In ssetObj
        retCoord = pickedObjs.Coordinates
        AppActivate Me.Caption
* {) P( \8 T! V- e$ ~        acadApp.WindowState = acMin
" t- E0 n) n$ Q$ u  f: ]        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
) O" t, Z, @& S* O, Y4 p                    If retCoord(0) = retCoord(j * 3 - 3) And retCoord(1) = retCoord(j * 3 - 2) Then  '闭合时
                        MSFlexGrid1.Rows = j
                    Else   '非闭合时
) D, Y% B$ }$ v2 E% x                        MSFlexGrid1.Rows = j + 1
; t: p: h& K+ s6 I& O                    End If
, m& k% L% O# a                    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 H; I! A' K" F: ?8 k            Next i
        ElseIf TypeOf pickedObjs Is AcadLWPolyline Then   '轻便多义线
2 I+ U4 @; p7 o7 D, e            j = (UBound(pickedObjs.Coordinates) + 1) / 2   '多义线的顶点数
            For i = 0 To j * 2 - 1 Step 2
. `* g6 r4 J! u' X                    If retCoord(0) = retCoord(j * 2 - 2) And retCoord(1) = retCoord(j * 2 - 1) Then '闭合时
' c+ f6 d  i0 v& {                        MSFlexGrid1.Rows = j
; o/ C) g$ f8 Z                    Else   '非闭合时
                        MSFlexGrid1.Rows = j + 1
+ t# A$ T2 l6 t5 m                    End If
                    '******MSFlexGrid1中只能列出多段线的坐标******
  Q( B1 n4 b  v$ f2 X                    '不支持面域
9 \/ H- f3 G( L* o# @) S                    MSFlexGrid1.TextMatrix(i / 2 + 1, 0) = i / 2 + 1
+ U$ @5 Z, J; W0 r' D4 x( ~                    'X坐标
                    MSFlexGrid1.TextMatrix(i / 2 + 1, 1) = Format(retCoord(i) / 1000 * Val(Text比例.Text), "0.000")         'X
9 d3 M" t0 k, I' i  v3 l                    'Y坐标
                    MSFlexGrid1.TextMatrix(i / 2 + 1, 2) = Format(retCoord(i + 1) / 1000 * Val(Text比例.Text), "0.000")     'Y
                    '面积
' w, g, x! B" {8 \3 _                    MSFlexGrid1.TextMatrix(i / 2 + 1, 3) = Format(pickedObjs.Area, "0.000") '面积
. E% ?1 \! z6 Q+ o6 h$ B                    MSFlexGrid1.Refresh
            Next i
4 i( O  Q4 a% F$ ^# z        Else
& f5 B: }9 K4 a             MsgBox "您选择的不是多段线！", 64 + vbOKOnly, "地质测量"
+ l0 @, F8 _& Y) D             ssetObj.Delete
        End If
        Exit For
    Next
    '删除选择集
( x. _* r' ]2 ]" Z8 P6 a    ssetObj.Delete
  ]. u* }2 n/ T6 uEnd Sub

6 U3 l/ ^' r( y. q$ w5 Y'==========================================================

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

dreamci

没有人能解吗？

seafree101300

注释,需要

a2166692

一点都没明白

kjava

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