图层名对应批量修改

wensanren

'Auto2004 使用C:\新旧图层名对照设定文件.INI　文件中设定的对应关系对当前图形文件图层更名
7 d- y8 C+ e. r0 y'可对含有中文的DWG档图层名修改以便ug读入
'INI文件中　[NEW_NAME]项目下为需修改的新图层名；　[OLD_NAME]项目下为需修改的旧图层名
  N6 l  O' G% G$ @  D'Change_row_count　＝　9 代表需修改的新旧图层行数
'使用的宏文件源代码如下：　作者　逍昇wensanren
Option Explicit
$ @, T/ m% w9 t$ U5 x2 {Private Declare Function GetPrivateProfileString Lib "kernel32" _
" F' h8 W3 [& z- g
Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, _

ByVal lpKeyName As Any, ByVal lpDefault As String, _

ByVal lpReturnedString As String, ByVal nSize As Long, _
8 A, X9 g7 ?# I
ByVal lpFileName As String) As Long
: z6 t) H+ d2 R+ J! ]/ Q: EPrivate Declare Function GetVolumeInformation Lib "kernel32.dll" Alias _
  m$ c" h9 ]" m6 e- X" Z
"GetVolumeInformationA" (ByVal lpRootPathName As String, _

ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Integer, _
/ o1 m! K5 K  D& {3 y9 u( I5 s7 f
( ?/ U5 x2 Y) ?) E: p) ClpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, _
0 y) ]1 ^% K1 G( H, M& c
lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, _

ByVal nFileSystemNameSize As Long) As Long
Sub replayer()
% U( Z0 q, [1 |# i  P  l: a% B8 gOn Error Resume Next
" ]+ g# K1 z( T. Q# g) g( N2 U0 XConst IniFile_Path = "C:\新旧图层名对照设定文件.INI"
Const ForReading = 1, ForWriting = 2, ForAppending = 3, TristateFalse = 0
' B* j" ]/ a$ l' ^' T/ T# `7 U'TristateFalse
. x7 ]- A5 X9 k" {) ?& \0 以 ASCII 格式打开文件
- t$ o& B' u: q& s/ B$ kDim fs, f As Object
Dim i, u, j, RowCount As Integer
Dim ent As AcadEntity
Dim Layerobj As AcadLayer
Dim oldname, newname, OLDNAMEFLAG, NEWNAMEFLAG, OldStr, NewStr, TMPSTR As String
, X. W  _3 ]& u) {# U. g
Dim Msg, Style, Title, Response, MyString
Msg = "[新图层名]　替代　[旧图层名] ?"
8 |1 v0 B" t0 l% ~' _, P/ A' 定义信息。
'Msg = "汉字 -> 字母(ASCII) ?"
Style = vbYesNo + vbCritical + vbDefaultButton2
+ [# y* {1 G# m/ I5 Y* O' 定义按钮。
Title = "MsgBox Demonstration"
' 定义标题。
7 p; Q% R2 G5 [$ m# m' {0 n
Response = MsgBox(Msg, Style, Title)
If Response = vbYes Then
' 用户按下“是”。[新图层名]替代[旧图层名]

OLDNAMEFLAG = "OLD_NAME"

NEWNAMEFLAG = "NEW_NAME"
. b4 L; X) P4 T1 |   
; @. Z9 Y3 X/ p. q8 _5 H, yElse
! I; a$ R' R( N% V5 ^3 E7 l' 用户按下“否”。[旧图层名]替代[新图层名]
% o4 @) p6 K4 c4 ]. g
, |1 I, d4 k4 R- A3 oOLDNAMEFLAG = "NEW_NAME"
& S: I7 z9 x' x- H
NEWNAMEFLAG = "OLD_NAME"
+ u8 A" I) I# u" p1 d; SEnd If
RowCount = CLng(ReadIniFile(IniFile_Path, "Change_row_count", "Change_row_count", "9"))
: f1 q" `' e0 `+ J2 b# N4 m2 O9 m3 Z'Change_row_count
# b% b7 P& }4 G/ M' F' `( D' aFor u = 1 To RowCount
OldStr = "Lay" + Trim(Str(u))
NewStr = "Lay" + Trim(Str(u))
, c0 r0 P  V- B2 E: f0 doldname = ReadIniFile(IniFile_Path, OLDNAMEFLAG, OldStr, "")
newname = ReadIniFile(IniFile_Path, NEWNAMEFLAG, NewStr, "XXX")
MyString = ""
. @$ e) W8 }2 I1 n8 h1 d' A' P+ jFor i = 0 To ThisDrawing.Application.Documents.Count - 1
ThisDrawing.Application.Documents.Item(i).Activate
# X7 f9 c3 ]3 Q! C2 p1 H; DFor j = 0 To ThisDrawing.Layers.Count - 1
Set Layerobj = ThisDrawing.Layers.Item(oldname)
6 b; F- z2 p, ?# o5 oLayerobj.Name = newname
# m5 A+ `: q4 v6 N$ UNext
MyString = MyString & Chr(13) & newname & " <- " & oldname & " " ' 最后一个被替代的
8 |% ?8 m' y5 I+ K2 g* rNext
! T: N( K" y4 E) y. Z( f$ U
Next
) r! _0 |3 ~! ?. }1 l. B/ rMsgBox ("替代完毕:" + Chr(13) + "最后一个为　" + MyString)
- S( i1 p+ ?5 B
End Sub

Public Function ReadIniFile(ByVal strIniFile As String, _

! z) a) i( ?/ SByVal strSECTION As String, ByVal strKey As String, gstrNull As String) As String
Dim strBuffer As String
% o; x4 m1 R' H. q7 @4 lDim intPos As Integer
% f+ g% U5 ]1 A2 a# J& DConst gintMAX_SIZE = 256
strBuffer = Space$(gintMAX_SIZE)
7 C% B' j& \: ?+ I7 nIf GetPrivateProfileString(strSECTION, strKey, gstrNull, strBuffer, gintMAX_SIZE, strIniFile) > 0 Then
2 L2 h. L. V) h3 t) dReadIniFile = strBuffer
- ]4 ]. @( M. D$ N. d" Q, RElse
4 x8 I: M% k, B& v' {
ReadIniFile = gstrNull
End If
2 |/ K8 E5 _! E( \2 Y: K8 @End Function
9 D3 x. _2 o6 r4 I
新旧图层名对照设定文件.INI （内容如下）
[OLD_NAME] 旧图层名
  u6 _0 Q. v' c% b  ^4 FLay1 =定义点
Lay2 =中心线
+ P0 N( f# Q: v" u# S7 ], rLay3 =注释

[NEW_NAME] 新图层名
! T; ~  \& ]1 L! f. |Lay1 =DefinPoint
: V# D( }, I' K) ?( V+ s) lLay2 =CenterLine
Lay3 = Note

9 y1 t# `9 r% U5 o/ s1 ]  i[Change_row_count]
Change_row_count = ３