使用平台是CAD2006

背景：这次要做的东西，名字有点绕，需求来源是这样的。如果有一批CAD图件，这里以一批1:500地形图为例，由于分幅面积小，所以总数量比较大，通常好几百甚至上千幅。当数据基本编辑完成，最后检查的时候，发现位于图件内的比例尺图示有误，需要更正。这里就隐含了一些条件了，比如各个图件内，图形的展布范围基本是一致的，而比例尺在各自图幅内的相对位置也是接近统一的。这时的需求就是批量替换比例尺，当然一种常用的处理办法是这样的：因为比例尺都放在TK图层，该层内其他内容通常也是批量生成的，那么直接全部TK层内容删除后重做，当然可以解决问题。

不过这一次，准备换一个思路，那就是用一个指定的东西，替换每个图幅内相对百分比位置的东西，是不是也可以解决问题呢？实话实说，这次尝试实现了最初的想法，但这个工具的适用范围着实不高，不过整个过程还是操练了好几种VBA

For AutoCAD的好几方面的东西：

A.

VBA制作AutoCAD的菜单并加载

B.

窗体设计以及通过菜单唤出窗体并输入参数

C.

图元分布范围的计算

D.

不同DWG文件间的图元内容复制，并移动到目标位置

首先，这次尝试做一下AutoCAD的菜单，通过菜单唤出窗体。

自定义菜单

第一个待解决的问题，如何自动加载菜单。搜索了一下，发现纯VBA环境貌似是无法实现自动加载的，所以想到了用“事件”的方式，即是说用DVB作为代码的载体，在启动CAD后手动加载DVB，这时DVB中和菜单建立相关的代码作为APP级别的事件，这里我选择了AcadDocument_Activate事件，即图形文件窗口激活这个条件。

VB Code

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

PrivateSubAcadDocument_activate()'菜单对象的层级关系：MenuGroups下通常有四个菜单组，第一组为默认ACAD,'第二组CUSTOM,第三组 MODELDOC,第四组CONTENTEXPLORER'一般新增的放在默认组，所以是，索引号为0 Item(0)'其下是PopupMenu对象，再下是PopupMenu的itemOnErrorResumeNext'该事件会被多次激活，所以会抛出错误DimcurrMenuGroupAsAcadMenuGroupSetcurrMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)' set currMenuGroup为默认菜单对象DimBrildo_MenuAsAcadPopupMenu'声明一个popupmenu对象SetBrildo_Menu = currMenuGroup.Menus.Add("Brildo_ToolBox")Dim替换指定范围, 分隔符AsAcadPopupMenuItemDimopenMacroAsString' 指定按钮对应宏的sub名字 格式固定 注意该sub 必须为publicopenMacro = Chr(3) & Chr(3) & Chr(95) &"-VBARUN form"& Chr(32)Set替换指定范围 = Brildo_Menu.AddMenuItem(Brildo_Menu.Count1, _"替换指定范围", openMacro)Set分隔符 = Brildo_Menu.AddSeparator("")' 在菜单栏上显示菜单Brildo_Menu.InsertInMenuBar (ThisDrawing.Application.MenuBar.Count1)EndSub

接下来是窗体的设计，无非是一些拖拽组合。最终效果如下：

窗体展示

我们希望实现的效果是通过点击菜单来唤出窗体，但是点击菜单本身只能对应运行一个Public

Sub，所以需要单独建立一个简单的公开过程，在其中唤出窗体：

VB Code

1

2

3

PublicSubform()

输入信息.ShowEndSub

每个按钮所涉及代码：

VB Code

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

PrivateSubCommanon1_Click()

file1 = CreateObject("WScript.Shell").Exec("mshta vbscript:"").StdOut.ReadAll

TextBox1 = file1EndSubPrivateSubCommanon2_Click()

file2 = CreateObject("WScript.Shell").Exec("mshta vbscript:"").StdOut.ReadAll

TextBox5 = file2EndSubPrivateSubCommanon3_Click()Setwshshell = CreateObject("Shell.Application")

dirpath = wshshell.BrowseForFolder(0,"请选择待处理文件目录",0,"").self.PathSetwshshell =NothingTextBox4 = dirpathEndSubPrivateSubLabel4_Click()

MsgBox"【说明】"& vbNewLine &"通过指定替换后的新内容，即替换文件"& vbNewLine &"以及替换内容位于示例文件中的位置"& vbNewLine &"完成目标文件夹下的批量替换"EndSubPrivateSubLabel5_Click()Me.hideCallReplace_Specific_Region(TextBox1, TextBox5, TextBox4, TextBox3, ComboBox1)EndSubPrivateSubSpinButton1_Change()

TextBox3 = Format((0CDbl(SpinButton1.Value /10)),"0.0") &"%"EndSubPrivateSubUserForm_Initialize()Me.ComboBox1.List = Array("左对齐","居中对齐","右对齐")

TextBox3 ="0%"last_value =0EndSub

前三个条形框分别展示“示例文件”、“替换文件”和“目标文件夹”的信息，通过点击左侧按钮弹出Windows的默认对话框作为交互方式。如何正确的弹出这个对话框，需要考虑到系统32位/64位的兼容性问题，以及最好是系统自带的实现方式，不需要对用户追加新的软件运行环境要求。最后采用的方法为：

CreateObject("WScript.Shell").Exec("mshta

vbscript:""

该方法选择文件，返回文件路径

CreateObject("Shell.Application").BrowseForFolder(0,

"请选择待处理文件目录",

0, "").self.Path

该方法选择文件夹，返回文件夹路径

这两种方法都具有很好的适用性，应该是VBA辉煌年代的遗产……

对齐方式预设了三种，左对齐、右对齐、居中对齐。表示新内容放入待替换的区域后的对齐方式；

最后是所谓【容差】，最初的考虑是这样的：从示例文件中得到的百分比范围在其他待处理的文件中定位不一定达到最好效果，因为待处理文件中希望被替换部分真实百分比可能有出入，所以用所谓容差来控制，在待处理文件中稍微扩大范围选取一部分空间，删除其中的现有内容，再将新内容放进去。【实际效果一般，我测试了前述大比例尺图件，由于不同图幅的整饰内容相差较大，所以必须要设定相当的容差才能将旧内容删除干净。但是引出了可以进一步优化的地方，比如计算范围时使用图号，就能准确抓取百分比，当然这并不适用于非标准分幅的图件，另一个思路是，扩大范围后所选取的内容做精细处理等】。

程序启动是用图片形式插入的。