工程测量之前,先来看看攻略

关注我们,了解更多工程测量姿势

Set acadapp = GetObject(, "AutoCAD.Application")

If Err Then

Set acadapp = CreateObject("AutoCAD.Application")

If Err Then MsgBoxErr.Description: Exit Sub

这样,当我们电脑里已经启动了AutocAD便会直接获取CAD应用程序对象,如果没有启动便会自动启动AutoCAD应用程序,启动如果失败,便会退出程序。

一个AutoCAD如同Excel有多张表一样,也可以有多张图,要绘入某张图,我们在CAD中点击选项卡把该图置为当前,这样我们就可以在Exce中用VBA代码在该图中绘图:

例如,我们要在AutoCAD中绘制一个文本,语句如下:

Dim Point1(0 to 2) as double

point1(0)=10:point1(1)=10:point1(2)=0

Set text = acadapp.ActiveDocument.ModelSpace.AddText(“里程”, Point, 30)

这样,我们就将“里程”绘到坐标为(10,10,0)的位置,文字高度30。

AutoCAD是一个很复杂的绘图系统,命令多得数不胜数,基本您能在Autocad中干的事,就能通过VBA代码来完成。

我们现在用VBA代码完成这样一件事:

在Excel中准备一张表格,并创建一个按钮,如图:

在按钮的过程处理中添加如下代码:

Sub Sheet1_按钮1_Click()

Dim acadapp As Object

Set acadapp = GetObject(, "AutoCAD.Application")

If Err Then

Set acadapp = CreateObject("AutoCAD.Application")

If Err Then MsgBoxErr.Description: Exit Sub

MsgBox "请到AutoCad中拾取一点或多点!,拾取完毕点击“ESC”或鼠标右键结束。"

Dim RowNum As Integer

On Error GoTo myerr

Point1 = acadapp.ActiveDocument.Utility.GetPoint

If Point1(0) = 0 And Point1(1) = 0 And Point1(2) = 0 Then Exit Do

Sheet5.Cells(RowNum, 1) = Point1(1)

Sheet5.Cells(RowNum, 2) = Point1(0)

Sheet5.Cells(RowNum, 3) = Point1(2)

RowNum = RowNum + 1

点击按钮后,Excel会处理等待状态,这时到AutoCAD中去捕获坐标点(不一定要捕获,左键乱点也行),完成后鼠标右键或按ESC键返回。这样坐标数据就全部到了Excel表格中。如下图:

这个小功能为测量人员提供了很多方便,比如在当设计图处于施工坐标系时要获取大量的坐标点。

自此,我们已经连载了6篇关于vba的应用,相信如果您连续认真看完并在Excel中试验成功过,即便从来没有接触过VBA也会有一定的认识。古语有云:授人以鱼不如授人以渔。公众号不太可能把所有涉及测量程序的VBA应用写完,只要入了门,修行就在个人了。祝您能在VBA的道路上有所斩获,逐渐将VBA变成您工作上的一个利器。

路漫漫其修远兮,吾将上下而求索。——屈原《离骚》