重新编号_如何利用脚本快速按顺序重新编号元器件的位号

设计原理图时，常常会遇到这样的问题。就是很多元器件的位号不是按顺序编号的，中间空了很多号没有用，有时候编号跨度很大。

比如上面的一个原理图，从中我们可以看到电阻的位号从R385一下子跨到了R4000，电阻只有300多个，但编号却编到了4000多。虽然位号对设计结果没有任何影响，但是查看原理图或者整理BOM时，会觉很乱，还有出贴片图时，编号数过大，元器件的外框放不下，有些数字会被丝印框挡住，看不清楚，或者被误读，给生产带来不便和风险。在PADS软件里尝试一个一个改过来，但是不好改，因为如果原理图页码多，元器件成百上千时，那真是无从下手了。所以，以前遇到这种事，都是保持现状。不过后来我学会了利用脚本的方法，编写好一个脚本，运行一下，一眨眼的功夫就把元器件的编号重新编号码了，而且是按顺序，中间没有断层。下面详细讲这个方法。

第一步，可以先写一个脚本查看一下原理图里哪些号是用上的，哪些号是没有用上的。打开脚本编辑器编写以下脚本并运行脚本，就可以弹出文档显示哪些号有用上，哪些号没有用上。

第二步，再打开脚本编辑器，编写以下代码。

参考代码：

Sub Main

Dim Rcount As Integer

Dim Ccount As Integer

Dim Lcount As Integer

Dim Dcount As Integer

Dim Qcount As Integer

Dim Jcount As Integer

Dim Ucount As Integer

Dim part_name As String

Dim sheets_count As Integer

sheets_count= ActiveDocument.Sheets.Count

'MsgBox sheets_count

'Set objs = ActiveDocument.GetObjects(,,True)

For Sheet_num = 1 To sheets_count

ActiveDocument.Sheets(Sheet_num).Activate

Set comps = ActiveDocument.ActiveSheet.Components

For i = 1 To comps.Count Step 1

part_name = comps.Item(i).Name

new_ref_num = Trim(Str(Val(Mid(part_name,2,4))+9000))

new_name = Mid(part_name,1,1) & new_ref_num

pre = UCase(Mid(part_name,1,1))

If pre = "R" Or pre = "C" Or pre = "L" Or pre = "D" Or pre = "Q" Or pre = "J" Or pre = "U" Then

If Val(Mid(part_name,2,5)) < 9000 Then

Let comps.Item(i).Name = new_name

End If

End If

Next i

Next Sheet_num

For Sheet_num = 1 To sheets_count

ActiveDocument.Sheets(Sheet_num).Activate

Set comps = ActiveDocument.ActiveSheet.Components

For i = 1 To comps.Count Step 1

part_name = comps.Item(i).Name

Select Case UCase((Mid(part_name,1,1)))

Case "R"

Rcount = Rcount +1

new_name = Mid(part_name,1,1) & Rcount

Let comps.Item(i).Name = new_name

Case "C"

Ccount = Ccount + 1

new_name = Mid(part_name,1,1) & Ccount

Let comps.Item(i).Name = new_name

Case "L"

Lcount = Lcount + 1

new_name = Mid(part_name,1,1) & Lcount

Let comps.Item(i).Name = new_name

Case "D"

Dcount = Dcount + 1

new_name = Mid(part_name,1,1) & Dcount

Let comps.Item(i).Name = new_name

Case "Q"

Qcount = Qcount + 1

new_name = Mid(part_name,1,1) & Qcount

Let comps.Item(i).Name = new_name

Case "J"

jcount = jcount + 1

new_name = Mid(part_name,1,1) & jcount

Let comps.Item(i).Name = new_name

Case "U"

Ucount = Ucount + 1

new_name = Mid(part_name,1,1) & Ucount

Let comps.Item(i).Name = new_name

End Select

Next i

Next Sheet_num

End Sub

第三步，运行代码，就可以看到页面在不断地闪动，元器件的编号在不断的变化，几秒钟的时间就完成了元器件编号的重新编码。如下图所示，刚才电阻编号为4000多的没有了，取而代之是300多了。

第四步，运用刚才检测元器件编号使用情况的脚本，验证一下编号有没有重新按顺序编排，结果如下。

从上图可以看出，元器件编号已经按顺序重新编排了。