一个连续\重复编号的程序!
Imports Autodesk.AutoCAD.ApplicationServicesImports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.GraphicsInterface
Imports System.IO
Public Class AddEntity_jig
Inherits DrawJig
Private targetPt, curPt As Point3d
Private i As Integer
Public suc_Add As Boolean
Private ents() As Entity, ids As ObjectId()
Public Sub New(实体集合() As Entity)
ents = 实体集合
End Sub
Sub AddEntity()
Dim db As Database = HostApplicationServices.WorkingDatabase
Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
' MsgBox(ids.Length)
Using trans As Transaction = db.TransactionManager.StartTransaction()
' 开始拖拽.
Dim jigRes As PromptResult = ed.Drag(Me)
If jigRes.Status = PromptStatus.OK Then
Dim bt As BlockTable = trans.GetObject(db.BlockTableId, OpenMode.ForRead)
Dim btr As BlockTableRecord = trans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
For i As Integer = 0 To ents.Length - 1
btr.AppendEntity(ents(i))
trans.AddNewlyCreatedDBObject(ents(i), True)
Next
End If
trans.Commit()
End Using
End Sub
Protected Overrides Function Sampler(prompts As JigPrompts) As SamplerStatus
' 定义一个点拖动交互类.
Dim optJig As New JigPromptPointOptions(vbCrLf & "请指定插入点:")
' 设置拖拽光标类型.
optJig.Cursor = CursorType.RubberBand
' 设置拖动光标基点.
optJig.BasePoint = targetPt
optJig.UseBasePoint = True
' 用AcquirePoint函数得到用户输入的点.
Dim resJig As PromptPointResult = prompts.AcquirePoint(optJig)
targetPt = resJig.Value
' 如果用户拖拽，则用矩阵变换的方法移动选择集中的全部对象.
If curPt <> targetPt Then
Dim moveMt As Matrix3d = Matrix3d.Displacement(targetPt - curPt)
For i = 0 To ents.Length - 1
ents(i).TransformBy(moveMt)
Next
' 保存当前点.
curPt = targetPt
Return SamplerStatus.OK
Else
Return SamplerStatus.NoChange
End If
End Function
Protected Overrides Function WorldDraw(draw As WorldDraw) As Boolean
For i = 0 To ents.Length - 1
' 刷新画面.
draw.Geometry.Draw(ents(i))
Next
Return True
End Function
End Class
'------------------------------------------------------编号代码---------------------------------------
Public Class bianhao
Private Shared count As Integer = 1
Public Sub 编号()
Dim db As Database = HostApplicationServices.WorkingDatabase
Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
IsESCDown = False
AddHandler Application.PreTranslateMessage, AddressOf Application_PreTranslateMessage
Do
Dim C1 As Circle = New Circle(New Point3d(0, 0, 0), Vector3d.ZAxis, 50)
Dim MT As MText = New MText
MT.Contents = count
MT.TextHeight = 70
MT.Location = New Point3d(0, 0, 0)
MT.Attachment = AttachmentPoint.MiddleCenter
Dim ents(1) As Entity
ents(0) = C1
ents(1) = MT
Dim JM As AddEntity_jig
JM = New AddEntity_jig(ents)
JM.AddEntity()
If IsEscDown = True Then '按下ESC跳出循环；移除keydown事件
RemoveHandler Application.PreTranslateMessage, AddressOf Application_PreTranslateMessage
Exit Sub
End If
If IsShiftDown = False Then
count = count + 1
End If
Loop 'Until (IsESCDown = True)
End Sub
Const WM_KEYDOWN As Integer = 256
Public IsEscDown As Boolean
Public IsShiftDown As Boolean
Public Delegate Sub KeyDown(keycode As Integer) '事件所需要的委托(注意，声明委托，必须加上括号)
Public Event OnKeyDown As KeyDown '事件声明
Public Delegate Sub KeyUp(keycode As Integer) '事件所需要的委托(注意，声明委托，必须加上括号)
Public Event OnKeyUp As KeyUp '事件声明
Sub Application_PreTranslateMessage(sender As Object, e As PreTranslateMessageEventArgs)
If (e.Message.message = WM_KEYDOWN) Then
'Tools.WriteMessageWithReturn(e.Message.wParam.ToString())
RaiseEvent OnKeyDown(e.Message.wParam.ToInt32())
' MsgBox(e.Message.message.ToString)
RaiseEvent OnKeyUp(e.Message.wParam.ToInt32())
End If
End Sub
Public Sub Esc_Down(KC As Integer) Handles MyClass.OnKeyDown
If KC.ToString = 27 Then
IsESCDown = True
Else
IsESCDown = False
End If
'MsgBox(IsESCDown.ToString)
End Sub
Public Sub Shift_down(KC As Integer) Handles MyClass.OnKeyDown
If KC.ToString = 16 Then
IsShiftDown = Not (IsShiftDown)
Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
If IsShiftDown.ToString = True Then
ed.WriteMessage(vbCrLf & "重复编号")
Else
ed.WriteMessage(vbCrLf & "连续编号")
End If
End If
' MsgBox(IsShiftDown.ToString)
End Sub
<CommandMethod("QK")> Public Sub 清空编号()
count = 1
End Sub
<CommandMethod("bh1")> Public Sub 设置新编号()
count = 函数库.输入整数("更新编号顺序")
编号()
End Sub
<CommandMethod("BBH")> Public Sub 继续编号()
编号()
End Sub
End Class
'主要是想练习下写动态添加实体的DRAWJIG, 顺手写了个编号的程序!lisp板块有很多编号的源码!但好多不能动态显示添加编号! 所以拿个简单的练练手! 按下SHIFT键 可以切换 '连续' 或者'重复'编号!本来想做成按住了SHIFT 重复编号 ,松开连续编号!无奈水平不够!还请老师傅指点下 如何实现此功能!
不错，下载学习，谢谢分享！ 不错，下载学习，谢谢分享！ 不错，下载学习，谢谢分享！ 不错，下载学习，谢谢分享！ 謝謝樓主的分享！
页:
[1]