一道VB＋CAD的图形难题

dreamci · 发表于 2009-5-21 21:42:13

马上注册，结识高手，享用更多资源，轻松玩转三维网社区。

您需要登录才可以下载或查看，没有帐号？注册

x

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

我的思路是：VB编程，用For……next将每个单元格用类似“BO”命令自动创建边界，形成多段线单元格，然后用以下代码获取多段线单元的顶点坐标和面积，输入到EXCEL或VB的MSFlexGrid控件中。

For  顶点号
   1、创建多段线单元
   2、提取多段线顶点坐标和面积信息
   3、将数据填写进EXCEL或VB的MSFlexGrid控件中
next 顶点号

For循环中第三部分代码大致如下：
'MSFlexGrid1中能列出多段线的坐标（我从网上下载到的源代码）

Private Sub cd多段线坐标查询_Click()
'==========================================================
  Dim acadApp As AcadApplication
  Dim ssetObj As AcadSelectionSet
  On Error Resume Next
  Set acadApp = GetObject(, "autoCAD.Application")
  acadApp.ActiveDocument.SelectionSets("hights").Delete
  Set ssetObj = acadApp.ActiveDocument.SelectionSets.Add("hights")
  AppActivate acadApp.Caption
  Dim FType(0) As Integer
  Dim FData(0) As Variant
  FType(0) = 0
  FData(0) = "line"


  Dim filterType As Variant
  Dim filterData As Variant
' filterType = FType
' filterData = FData
' ssetObj.Select acSelectionSetAll, , , filterType, filterData
'                                                                               'AppActivate userform1.Caption
'
' Dim pickedObjs As AcadEntity
' For Each pickedObjs In ssetObj
' pickedObjs.Highlight (True)
' Next
' ssetObj.Delete

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

'安全创建选择集
'Dim ssetObj As AcadSelectionSet
If Not IsNull(acadApp.ActiveDocument.SelectionSets.Item("Test")) Then
      Set ssetObj = acadApp.ActiveDocument.SelectionSets.Item("Test")
      ssetObj.Delete
End If

'创建选择集
Set ssetObj = acadApp.ActiveDocument.SelectionSets.Add("Test")

'激活CAD窗口
AppActivate acadApp.Caption
acadApp.WindowState = acMax
'提示用户从屏幕选择实体对象，并加入选择集
ssetObj.SelectOnScreen
ssetObj.Select acSelectionSetAll  '选择所有曲线

'选择完毕后按回车键或单击右键
'Dim pickedObjs As AcadEntity
Dim retCoord As Variant
For Each pickedObjs In ssetObj
      retCoord = pickedObjs.Coordinates
      AppActivate Me.Caption
      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
                  Else '非闭合时
                     MSFlexGrid1.Rows = j + 1
                  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")

         Next i
      ElseIf TypeOf pickedObjs Is AcadLWPolyline Then '轻便多义线
         j = (UBound(pickedObjs.Coordinates) + 1) / 2 '多义线的顶点数
         For i = 0 To j * 2 - 1 Step 2
                  If retCoord(0) = retCoord(j * 2 - 2) And retCoord(1) = retCoord(j * 2 - 1) Then '闭合时
                     MSFlexGrid1.Rows = j
                  Else '非闭合时
                     MSFlexGrid1.Rows = j + 1
                  End If
                  '******MSFlexGrid1中只能列出多段线的坐标******
                  '不支持面域
                  MSFlexGrid1.TextMatrix(i / 2 + 1, 0) = i / 2 + 1
                  'X坐标
                  MSFlexGrid1.TextMatrix(i / 2 + 1, 1) = Format(retCoord(i) / 1000 * Val(Text比例.Text), "0.000")       'X
                  'Y坐标
                  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
         Next i
      Else
         MsgBox "您选择的不是多段线！", 64 + vbOKOnly, "地质测量"
         ssetObj.Delete
      End If
      Exit For
Next
'删除选择集
ssetObj.Delete
End Sub

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

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

dreamci · 发表于 2009-5-25 19:25:27

没有人能解吗？

seafree101300 · 发表于 2009-6-7 19:27:14

注释,需要

a2166692 · 发表于 2009-6-10 17:47:18

一点都没明白

kjava · 发表于 2009-7-8 10:34:41

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

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

通知

[讨论] 一道VB＋CAD的图形难题

马上注册，结识高手，享用更多资源，轻松玩转三维网社区。

浏览过的版块