李辉 发表于 2011-9-25 13:34:01

哪位高人帮我看一下，我的选择集错在哪里？

本帖最后由 李辉 于 2011-9-25 13:36 编辑

目标是：通过过切换窗格按钮状态，读取autocad上的线条信息，进而读取线条的XDATA和其他信息。
但是我在选择线条的时候老出错，不知道为什么，请那个高人帮忙指点一下。
我是通过激发SelectionAddedEventArgs事件，知道用户对线条进行选择的。
原来我通过命令通过交互方式选择线条（杆件）是没有问题的。
改为SelectionAdded后就挂了，请大侠帮忙！！！非常感谢

Option Explicit On
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.Windows
Imports AcadApp = Autodesk.AutoCAD.ApplicationServices.Application
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Colors
Imports System.IO
Imports System.Math
Public Class GetSelInf
    Public Shared appPaneButton As Pane
    Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
   
    Sub OnAppMouseDown(ByVal sender As Object, ByVal e As StatusBarMouseDownEventArgs)
      '获取窗格按钮对象
      Dim paneButton As Pane = CType(sender, Pane)
      '如果点击的不是鼠标左键，则返回
      If e.Button <> Windows.Forms.MouseButtons.Left Then
            Return
      End If
      '切换窗格按钮的状态
      If paneButton.Style = PaneStyles.PopOut Then '如果窗格按钮是弹出的，则切换为凹进
            paneButton.Style = PaneStyles.Normal
            AddHandler ed.SelectionAdded, AddressOf doc_ImpliedSelectionChanged
            ed.WriteMessage("查看属性，请选择杆件" + vbCrLf)
      Else
            paneButton.Style = PaneStyles.PopOut
            RemoveHandler ed.SelectionAdded, AddressOf doc_ImpliedSelectionChanged
            ed.WriteMessage("关闭查看属性" + vbCrLf)
      End If
      '更新状态栏以反映窗格按钮的状态变化
      Application.StatusBar.Update()
      '显示反映窗格按钮变化的信息
    End Sub
   
    private Sub AddApplicationPane()
      '定义一个程序窗格对象
      appPaneButton = New Pane
      '设置窗格的属性
      appPaneButton.Enabled = ture
      appPaneButton.Visible = ture
      '设置窗格初始状态是弹出的
      appPaneButton.Style = PaneStyles.PopOut
      '设置窗格的标题
      appPaneButton.Text = "杆件属性"
      '显示窗格的提示信息
      appPaneButton.ToolTipText = "查看杆件满力度等信息"
      '添加MouseDown事件，当鼠标被按下时运行
      AddHandler appPaneButton.MouseDown, AddressOf OnAppMouseDown
      '把窗格添加到AutoCAD的状态栏区域
      Application.StatusBar.Panes.Add(appPaneButton)
    End Sub
   
   
    Private Sub GetSelInf_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
      Call AddApplicationPane()
    End Sub
   
   
    Public Sub doc_ImpliedSelectionChanged(ByVal sender As System.Object, ByVal e As SelectionAddedEventArgs)
      ' 定义一个选择集交互类.
      Dim db As Database = HostApplicationServices.WorkingDatabase
      Dim optSel As New PromptSelectionOptions
      ' 返回选择集的用户提示类.
      Dim resSel As PromptSelectionResult = ed.SelectImplied()
      ' 得到选择集对象.
      Dim stxt As Integer
      stxt = 0
      If resSel.Status <> PromptStatus.OK Then
            ed.WriteMessage(("选择取消" + vbCrLf))
            Return
      Else
            Dim sSet As SelectionSet = resSel.Value
            ' 得到选择集中所有对象的ObjectId集合.                        ‘’‘’‘’‘’这里开始出错
            Dim ids As ObjectId() = sSet.GetObjectIds()
            Using trans As Transaction = db.TransactionManager.StartTransaction()
                ' 遍历选择集.
                Dim doclock As DocumentLock = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.LockDocument
                For Each sSetEntId As ObjectId In ids
                  Dim ent As Entity = trans.GetObject(sSetEntId, OpenMode.ForWrite)
                  ' 修改所选择对象的颜色.
                  If ent.Layer = "0" And ent.GetType().Name = "Line" Then
                        stxt = stxt + 1
                  End If
                Next sSetEntId
                trans.Commit()
                doclock.Dispose()
            End Using
      End If
    End Sub
End Class

哭泣殺豬 发表于 2011-9-25 13:54:39

' 返回选择集的用户提示类.
      Dim resSel As PromptSelectionResult = ed.SelectImplied()

試試看改為
optSel.MessageForAdding = "選取物件"
      Dim resSel As PromptSelectionResult = ed.GetSelection(optSel)

哭泣殺豬 发表于 2011-9-25 14:02:47

沒看清楚內容,sorry
繼續試看看
页: [1]
查看完整版本: 哪位高人帮我看一下，我的选择集错在哪里？