- 积分
- 170
- 明经币
- 个
- 注册时间
- 2011-9-22
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
本帖最后由 李辉 于 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
|
|