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

在AUTOCAD2006 中 添加一个自定义加法器工具 武汉市江夏区勘测院 金卫东 2 0 0 7 年 7 月 1 本人在用AUTOCAD 软件作图的日常工作中，经常会遇到要用图上的数字注记，进行加减运算的简单计算工作。通常情况下，是调用系统的计算器程序，通过手工输入或复制粘贴的方式来完成这项工作。而这种方式较为繁琐，如果能够通过鼠标直接点取相应的数字注记，来得到最终的累加结果，这样就非常有效率且直截了当。 解决方法：在AUTOCAD2006 中编写一个VBA 程序add.dvb,通过自定义栏中定义一个工具“加法器”，来调用这个程序，即可达到目的。 1 加法器add.dvb 源程序 程序功能：通过在图上选择需要累加的数字注记，将其变为黄色，若数字注记中有等号，则仅取最后一个等号右侧的数字，依次累加，鼠标右键单击结束选择，在鼠标指定的位置标注计算结果。 ★注意，1）在使用这个工具的过程中，选择需要累加的数字注记时，鼠标左键不要双击，以免重复选中对象造成累加结果错误。 2）为确保结果正确，在累计的个数较多时，建议做两次运算，确认结果无误。 3）若选中的对象非数字注记，则相当于选中数字“0”。 AutoCAD 对象，ThisDraw ing 代码 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 & "指定放置位置: " 2 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 = L Trim(Str(sum)) ' 创建 Text 对象 Set textObjSum = ThisDrawing.ModelSpa...