点监视器和Hook的结合应用

tiancao1001

转换一下VB.net

Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.Runtime

Public Class MyCommands

    Const WM_KEYDOWN As Integer = 256
    Const WM_KEYUP As Integer = 257
    Const WM_SYSKEYDOWN As Integer = 260
    Const WM_SYSKEYUP As Integer = 261

    Private _curEditor As Editor
    Private _mObjectId As ObjectId = ObjectId.Null

    Private _mScalefactor As Double
    Private _mTolerance As Tolerance

    Private Sub UpDownKeyHandler(ByVal sender As Object, ByVal e As PreTranslateMessageEventArgs)
        Select Case e.Message.message
            Case WM_KEYDOWN
                Dim ptr = e.Message.wParam.ToInt32()
                Select Case ptr
                    Case 37
                        If _mScalefactor > 0.5 Then
                            _mScalefactor -= 0.1
                        End If
                        Exit Select
                    Case 39
                        _mScalefactor += 0.1
                        Exit Select
                    Case Else
                        Exit Select
                End Select
                Exit Select
            Case WM_SYSKEYDOWN
                Exit Select
            Case WM_KEYUP
                Exit Select
            Case WM_SYSKEYUP
                Exit Select
            Case Else
                Exit Select
        End Select
    End Sub



    Private Sub My_PointMonitor(ByVal sender As Object, ByVal e As PointMonitorEventArgs)
        If _mObjectId = ObjectId.Null Then
            Return
        End If
        Dim db = Application.DocumentManager.MdiActiveDocument.Database
        Try
            Using tr = db.TransactionManager.StartTransaction()
                Dim scl = _mScalefactor
                Dim blk = CType(tr.GetObject(_mObjectId, OpenMode.ForWrite), BlockReference)
                If blk IsNot Nothing Then
                    If Not blk.Position.IsEqualTo(e.Context.ComputedPoint) Then
                        blk.Position = e.Context.ComputedPoint
                    End If
                    blk.ScaleFactors = New Scale3d(scl)
                End If
                tr.Commit()
            End Using
        Catch generatedExceptionName As System.Exception
            Throw
        End Try
    End Sub

    <CommandMethod("myinsert")> _
    Public Sub MyInsert()
        Dim doc = Application.DocumentManager.MdiActiveDocument
        _curEditor = doc.Editor
        _mTolerance = New Tolerance(0.001, 0.001)
        _mScalefactor = 1.0
        Dim db = doc.Database
        Try
            Dim peo As New PromptEntityOptions(vbLf & "Select Insert")
            peo.SetRejectMessage("**Only Insert*")
            peo.AddAllowedClass(GetType(BlockReference), True)
            Dim per = _curEditor.GetEntity(peo)
            If per.Status <> PromptStatus.OK Then
                Return
            End If
            _mObjectId = per.ObjectId
            AddHandler Application.PreTranslateMessage, AddressOf UpDownKeyHandler
            AddHandler _curEditor.PointMonitor, AddressOf My_PointMonitor
            Dim ppo = New PromptPointOptions(vbLf & "Position")
            Dim ppr = _curEditor.GetPoint(ppo)
            If ppr.Status <> PromptStatus.OK Then
                Return
            End If
            RemoveHandler Application.PreTranslateMessage, AddressOf UpDownKeyHandler
            RemoveHandler _curEditor.PointMonitor, AddressOf My_PointMonitor
        Catch generatedExceptionName As System.Exception
            _curEditor.WriteMessage(vbLf & "*error*")
        Finally
            RemoveHandler Application.PreTranslateMessage, AddressOf UpDownKeyHandler
            RemoveHandler _curEditor.PointMonitor, AddressOf My_PointMonitor
        End Try
    End Sub


End Class

__april

向斑竹学习！很强啊~~~

z954134@126.com

我也来学习学习

xgr669

这个牛，看看

brainstorm

感谢楼主分享
来自: 微社区

18093739661

知识好丰富，好好学习天天向上

brainstorm

提示需要引用windowsbase如何如何解决
来自: 微社区

quickmap

学习学习。
来自: 微社区

lxw0320

很好的一个例子

xiongdi6k

666

819534890

回复学习，谢谢分享

xxxxxxxxx123

谢谢分享   看一下  。。。。

Cherish易

学习学习！！！试试hook！

Cherish易

学习学习！！！试试hook！

hcrogetA

学习一下，谢谢分享