图层名对应批量修改

wensanren

'Auto2004 使用C:\新旧图层名对照设定文件.INI　文件中设定的对应关系对当前图形文件图层更名
'可对含有中文的DWG档图层名修改以便ug读入
+ d% C1 A, d- w, E" s& t'INI文件中　[NEW_NAME]项目下为需修改的新图层名；　[OLD_NAME]项目下为需修改的旧图层名
9 V0 |! n1 H& E1 d% G5 q: t3 J'Change_row_count　＝　9 代表需修改的新旧图层行数
'使用的宏文件源代码如下：　作者　逍昇wensanren
Option Explicit
5 U( ~9 d+ @. l" s* h# }- mPrivate Declare Function GetPrivateProfileString Lib "kernel32" _
- S: F- t* J& Y0 {- C
) ^2 Q/ f! Z3 T( oAlias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, _

ByVal lpKeyName As Any, ByVal lpDefault As String, _
& t" j! B/ E$ f7 S% r5 z
ByVal lpReturnedString As String, ByVal nSize As Long, _
: Y2 L/ K5 ^) p& e. E6 k7 ]" ?; E  r& }
ByVal lpFileName As String) As Long
6 ^( R! \) h0 S5 T2 a9 f& j: l/ s( m* Q0 tPrivate Declare Function GetVolumeInformation Lib "kernel32.dll" Alias _
& X# H* R* q) v% s8 Q, f
$ b  y6 j2 R! F: I"GetVolumeInformationA" (ByVal lpRootPathName As String, _
$ P. d- Z9 a! p$ C& j
" r9 I" w2 @+ V# ]9 qByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Integer, _

lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, _
+ I2 t" H3 X) {1 v7 S: |
lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, _
9 ]5 Y( V+ z& @. j6 y
+ F( R& x$ s1 e; P8 cByVal nFileSystemNameSize As Long) As Long
Sub replayer()
On Error Resume Next
( r* V% _7 d+ n* d# x9 U, ]Const IniFile_Path = "C:\新旧图层名对照设定文件.INI"
9 P. C& _9 T0 i+ Z2 n4 p0 G. mConst ForReading = 1, ForWriting = 2, ForAppending = 3, TristateFalse = 0
5 j+ |5 t& o5 W0 ]4 D& P( h6 P'TristateFalse
0 以 ASCII 格式打开文件
Dim fs, f As Object
3 I8 n3 y+ L) X0 O" CDim i, u, j, RowCount As Integer
Dim ent As AcadEntity
Dim Layerobj As AcadLayer
/ t. f$ X  o5 p0 y. ]Dim oldname, newname, OLDNAMEFLAG, NEWNAMEFLAG, OldStr, NewStr, TMPSTR As String

$ B! Z5 k% s2 h8 F; N4 tDim Msg, Style, Title, Response, MyString
Msg = "[新图层名]　替代　[旧图层名] ?"
% a: f: Y# T) w. u' 定义信息。
, _) ~2 A$ W$ E9 m'Msg = "汉字 -> 字母(ASCII) ?"
5 r1 W; ]  U" zStyle = vbYesNo + vbCritical + vbDefaultButton2
) w- h5 Y9 ]: X  d8 B' ^0 u% H' 定义按钮。
Title = "MsgBox Demonstration"
' 定义标题。

Response = MsgBox(Msg, Style, Title)
If Response = vbYes Then
' 用户按下“是”。[新图层名]替代[旧图层名]
' |/ [- S6 E7 [/ q
9 U- h% h; I+ l( K+ dOLDNAMEFLAG = "OLD_NAME"

NEWNAMEFLAG = "NEW_NAME"
   
Else
' o6 y' K, q& V5 F) Z6 o& q' 用户按下“否”。[旧图层名]替代[新图层名]

; F7 B, Z6 ?; e' w' }9 nOLDNAMEFLAG = "NEW_NAME"
$ y+ v, U* [! {; M# ~* h
* X1 Z- V4 I) }' ENEWNAMEFLAG = "OLD_NAME"
End If
* E' W' i* i0 m* ^RowCount = CLng(ReadIniFile(IniFile_Path, "Change_row_count", "Change_row_count", "9"))
'Change_row_count
) f4 @& j* I2 _$ W# QFor u = 1 To RowCount
( Z' B# t3 y6 v+ l; |( MOldStr = "Lay" + Trim(Str(u))
NewStr = "Lay" + Trim(Str(u))
" n+ H# T4 I) y9 i( ^oldname = ReadIniFile(IniFile_Path, OLDNAMEFLAG, OldStr, "")
newname = ReadIniFile(IniFile_Path, NEWNAMEFLAG, NewStr, "XXX")
MyString = ""
For i = 0 To ThisDrawing.Application.Documents.Count - 1
6 P# g# j2 L% l; K+ u3 k% oThisDrawing.Application.Documents.Item(i).Activate
- j2 Y0 V  k6 n+ o2 U  K/ o9 xFor j = 0 To ThisDrawing.Layers.Count - 1
2 h' A, j$ L# W9 J3 g# bSet Layerobj = ThisDrawing.Layers.Item(oldname)
Layerobj.Name = newname
Next
- `0 E7 {; R% EMyString = MyString & Chr(13) & newname & " <- " & oldname & " " ' 最后一个被替代的
Next

Next
+ P6 R0 E( s6 g/ Z  r) R4 I+ }MsgBox ("替代完毕:" + Chr(13) + "最后一个为　" + MyString)

End Sub

Public Function ReadIniFile(ByVal strIniFile As String, _

( [( t. \: W+ D' d8 _, NByVal strSECTION As String, ByVal strKey As String, gstrNull As String) As String
Dim strBuffer As String
Dim intPos As Integer
7 b) u  y0 ^; m7 ~/ l8 v% ^9 ~0 iConst gintMAX_SIZE = 256
2 I+ w0 {, K7 u% X% v6 d- astrBuffer = Space$(gintMAX_SIZE)
! i/ O, t3 Z! }6 RIf GetPrivateProfileString(strSECTION, strKey, gstrNull, strBuffer, gintMAX_SIZE, strIniFile) > 0 Then
ReadIniFile = strBuffer
/ i) F8 M0 v! r; P6 nElse

' ^% }7 {0 t6 ^6 O( WReadIniFile = gstrNull
End If
End Function

* _' ]$ ?, ^  D9 v/ |9 w新旧图层名对照设定文件.INI （内容如下）
[OLD_NAME] 旧图层名
& P; W$ ^6 o* t! B* l- B3 h! HLay1 =定义点
Lay2 =中心线
Lay3 =注释
- f3 u' }9 S: C( [1 x, z. P3 r
/ e% j- N# |) D8 v[NEW_NAME] 新图层名
Lay1 =DefinPoint
, e: x4 Z/ h; X. p# MLay2 =CenterLine
Lay3 = Note

+ |- S- p- P; Y& o# k[Change_row_count]
! `0 L6 F( U4 T. |/ pChange_row_count = ３