一个连续\重复编号的程序!

偶尔做做怪

Imports Autodesk.AutoCAD.ApplicationServices
Imports 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 重复编号 ,松开连续编号!无奈水平不够!还请老师傅指点下 如何实现此功能!  

wwswwswws

不错，下载学习，谢谢分享！

sowin360

不错，下载学习，谢谢分享！

qq509103902

不错，下载学习，谢谢分享！

atrixs

不错，下载学习，谢谢分享！

ZYX2129

謝謝樓主的分享！