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
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
[本日志由 tiancao1001 于 2018-11-13 05:46 PM 编辑]
|
暂时没有评论
发表评论 - 不要忘了输入验证码哦! |