(1) 创建新图层

2. Sub AddNewLevel()
3.     
4.     ' Function:    创建新层
5.     ' Creater:       anzi
6.     ' Create Time: 2008年10月12日
7.     ' Description: 包括一下功能:
8.     '              (1) 层名转化为大写字母;
9.     '              (2) 包含容错处理机制;
10.     Dim strNewLevelName As String
11.     Dim lvlExistLevelName As Level
12.     
13. Hander:
14.     strNewLevelName = Trim(Ucase(InputBox("请输入新层的名称:")))
15.     
16.     For Each lvlExistLevelName In Application.ActiveDesignFile.Levels
17.         If StrComp(strNewLevelName, lvlExistLevelName.Name, vbTextCompare) = 0 Then
18.             MsgBox "层 '" & strNewLevelName & "' 已经存在,请另取名字."
19.             GoTo Hander
20.         End If
21.     Next
22.     
23.     ' 新增层
24.     Application.ActiveDesignFile.AddNewLevel strNewLevelName
25.     
26.     ' 刷新层管理器,将新层显示出来
27.     Application.ActiveDesignFile.Levels.Rewrite
28. End Sub