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 _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

分享到： QQ空间 新浪微博 腾讯微博 微信 更多

发表评论 - 不要忘了输入验证码哦！
作者：	用户：  密码：   注册？ 验证：  防止恶意留言请输入问题答案：1*5=?
评论： 禁止表情 禁止UBB 禁止图片 识别链接 识别关键字	表  情