点监视器和Hook的结合应用



http://bbs.xdcad.net/thread-709250-1-1.html
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 Sub UpDownKeyHandler(ByVal sender As Object, ByVal e As PreTranslateMessageEventArgs)
        Select Case e.Message.message
            Case WM_KEYDOWN
                Dim ptr As Object = 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
        Try
            Dim db As Object = Application.DocumentManager.MdiActiveDocument.Database
            Dim documentLock As DocumentLock = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.LockDocument()
            Using tr As Transaction = db.TransactionManager.StartTransaction()
                Dim scl As Double = _mScalefactor
                Dim blk As BlockReference = 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, scl, scl)
                End If
                tr.Commit()
            End Using
            DocumentLock.Dispose()
        Catch Ex As System.Exception
            Throw
        End Try
    End Sub

    <CommandMethod("myinsert")> _
    Public Sub MyInsert()
        Dim doc As Object = Application.DocumentManager.MdiActiveDocument
        _curEditor = doc.Editor
        _mScalefactor = 1.0
        Dim db As Object = doc.Database
        Try
            Dim peo As New PromptEntityOptions(vbLf & "选择参照块")
            peo.SetRejectMessage("只能选择参照块")
            peo.AddAllowedClass(GetType(BlockReference), True)
            Dim per As Object = _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 As Object = New PromptPointOptions(vbLf & "插入点")
            Dim ppr As Object = _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 & generatedExceptionName.Message)
        Finally
            RemoveHandler Application.PreTranslateMessage, AddressOf UpDownKeyHandler
            RemoveHandler _curEditor.PointMonitor, AddressOf My_PointMonitor
        End Try
    End Sub
End Class




在这神奇的国度,也出现这伟大的符号



欢迎关注微信公众账号ByCAD