在CAD2006中自定义工具栏添加一个自编加法器程序

在CAD中进行VBA编程应用

在AUTOCAD2006中 添加一个自定义加法器工具

武汉市江夏区勘测院 金卫东

2007年7月

在CAD中进行VBA编程应用

本人在用AUTOCAD软件作图的日常工作中，经常会遇到要用图上的数字注记，进行加减运算的简单计算工作。通常情况下，是调用系统的计算器程序，通过手工输入或复制粘贴的方式来完成这项工作。而这种方式较为繁琐，如果能够通过鼠标直接点取相应的数字注记，来得到最终的累加结果，这样就非常有效率且直截了当。

解决方法：在AUTOCAD2006中编写一个VBA程序add.dvb,通过自定义栏中定义一个工具“加法器”，来调用这个程序，即可达到目的。

1加法器add.dvb源程序

程序功能：通过在图上选择需要累加的数字注记，将其变为黄色，若数字注记中有等号，则仅取最后一个等号右侧的数字，依次累加，鼠标右键单击结束选择，在鼠标指定的位置标注计算结果。

★注意，1）在使用这个工具的过程中，选择需要累加的数字注记时，鼠标左键不要双击，

以免重复选中对象造成累加结果错误。

2）为确保结果正确，在累计的个数较多时，建议做两次运算，确认结果无误。

3）若选中的对象非数字注记，则相当于选中数字“0”。

AutoCAD对象，ThisDrawing代码

Option Explicit

Dim mspaceObj As AcadText Dim sum As Double Dim cs As String

Dim ns As Double

Sub add()

Dim basePnt As Variant

Dim l As Integer

Dim i As Integer, j As Integer Dim t As String

Dim CurrentColor As Variant sum = 0

On Error Resume Next

RETRY:

ThisDrawing.Utility.GetEntity mspaceObj, basePnt, "请选择需要累加的数字注记"

If Err <> 0 Then Err.Clear

Dim prompt1 As String

Dim startPnt As Variant

Dim insPoint1(0 To 2) As Double '声明插入点

prompt1 = vbCrLf & "指定放置位置: "

在CAD中进行VBA编程应用

Dim textHeight As Double '声明文字高度 Dim textStrSum As String '声明字符串

Dim textObjSum As AcadText '声明文字对象

' 在不输入基点的情况下获取第一点

startPnt = ThisDrawing.Utility.GetPoint(, prompt1) insPoint1(0) = startPnt(0) insPoint1(1) = startPnt(1) insPoint1(2) = startPnt(2)

textHeight = 1 '文字高度设置为 1 textStrSum = LTrim(Str(sum))

' 创建 Text 对象

Set textObjSum = ThisDrawing.ModelSpace.AddText _ (textStrSum, insPoint1, textHeight)

Exit Sub

Else

CurrentColor = mspaceObj.color

mspaceObj.color = acYellow '选中对象变黄色 mspaceObj.Update

If mspaceObj.ObjectName = "AcDbText" Then

cs = LTrim(mspaceObj.TextString) l = Len(cs): j = 0 For i = 1 To l

t = Mid(cs, i, 1) If t = "=" Then j = i

Next i

If j <> 0 Then '只选择“=”号右边的数字 cs = Right(cs, l - j) cs = LTrim(cs) End If

ns = Val(cs) sum = sum + ns End If End If

GoTo RETRY End Sub

在CAD中进行VBA编程应用

2 自定义工具栏

2.1将加法器程序add.dvb，以及工具栏图标文件add.bmp等保存到ACAD2006目录下。如C:\Program Files\AutoCAD 2006。

2.2自定义工具栏步骤：

启动CAD,在工具栏空白处，鼠标右键单击，在弹出的快捷菜单中选择“自定义”（如图2-1）。

（图2-1）

在CAD中进行VBA编程应用

在自定义用户界面的所有CUI文件中的自定义面板中，鼠标右键单击“工具栏”，在弹出的快捷菜单中选择“新建”→“工具栏”（如图2-2）。

（图2-2）

在CAD中进行VBA编程应用

将新建的工具栏“工具栏1”名称改为自己想要的名字如“myTOLLS”（如图2-3、图2-4）。

（图2-3）

在CAD中进行VBA编程应用

（图2-4）

在CAD中进行VBA编程应用

在命令列表面板中，鼠标左键单击“新建”（如图2-5）

（图2-5）

在CAD中进行VBA编程应用

在特性面板中，将新建的命令“命令1”名称改为“加法器” （如图2-6、图2-7）。

（图2-6）

在CAD中进行VBA编程应用

（图2-7）

在CAD中进行VBA编程应用

填写宏“-VBARUN add.dvb!ThisDrawing.add”

（图2-8）

在CAD中进行VBA编程应用

通过点击“．．．”按钮，选择按钮图像（小图像）文件的路径，如C:\Program Files\AutoCAD 2006\add.bmp（如图2-9）

（图2-9）

在CAD中进行VBA编程应用

在按钮图像面板上，选择前面加载的按钮图像（如图2-10、图2-11）

（图2-10）

在CAD中进行VBA编程应用

（图2-11）

在CAD中进行VBA编程应用

鼠标左键点按命令列表面板中的“加法器”命令不放（图2-12）

（图2-12）

在CAD中进行VBA编程应用

拖到所有CUI文件中的自定义面板中的自定义工具栏“myTOOLS”处（如图2-13）

（图2-13）