xiaxiang 发表于 2010-6-22 17:30:00

[求助]数字自动编号

本帖最后由 作者 于 2010-6-25 11:52:27 编辑 <br /><br /> <p>哪位能帮我实现这个功能，感谢了</p>
<p></p>
<p>请教高手：有没有哪种软件可以实现，有如下一堆数字在图形中，六位的，数字的编号为000101至019999，无序放置，需要重新编号，顺寻可以自己定义。</p>

rongyifei 发表于 2010-6-22 20:08:00

太快了，看不清！

顽石 发表于 2010-6-22 23:25:00

<p>看起来很简单，但请用文字将需求描述清楚</p>
<p>&nbsp;</p>

xiaxiang 发表于 2010-6-25 11:52:00

<p>请教高手：有没有哪种软件可以实现，有如下一堆数字在图形中，六位的，数字的编号为000101至019999，无序放置，需要重新编号，顺寻可以自己定义。</p>
<p>&nbsp;</p>

gufeng 发表于 2010-6-25 15:13:00

详细说明一下怎么个重新编号

tth02 发表于 2011-7-13 15:02:21

貌似就是在原来数字的基础上增加200

tth02 发表于 2011-7-13 15:17:26

本帖最后由 tth02 于 2011-7-13 15:18 编辑

用vba写了一个，可以实线楼主图片中展示的功能。
代码如下：

Sub add200()
Dim SSet As AcadSelectionSet, objText As AcadText, str1 As String
Dim n As Integer, ii As Integer, jj As Integer
Do While ThisDrawing.SelectionSets.count > 0
            ThisDrawing.SelectionSets.Item(0).Delete
Loop
n = ThisDrawing.Utility.GetInteger("输入需要增加的数字，负数表示减：")
Set SSet = ThisDrawing.SelectionSets.Add("add200")
Dim ft(0) As Integer, fd(0) As Variant
ft(0) = 0
fd(0) = "TEXT"
SSet.SelectOnScreen ft, fd
For Each objText In SSet
    str1 = objText.TextString
    For ii = 1 To Len(str1)
      If Mid(str1, ii, 1) > "0" Then Exit For
    Next ii
    str1 = Right(str1, Len(str1) - ii + 1)
    str1 = CStr(CInt(str1) + n)
    For jj = 1 To ii - 1
      str1 = "0" & str1
    Next jj
    objText.TextString = str1
Next objText
End Sub

yygusong 发表于 2011-8-9 17:55:00

很实用，做目录能用的上
页: [1]
查看完整版本: [求助]数字自动编号