|
|
工作中碰到GPS采集的坐标，要绘制到CAD，所以研究了一下，下面的文件包是一个原型代码，虽然只有几十行，但是是一个完整的代码，包含的读取表格、自动按坐标绘制路径、添加路径点名称。
使用方法，打开“测试坐标”的表格文件、打开“模板”的CAD文件，运行“测试”，或者是用VB打开测试工程运行，或者是将代码复制到你的环境中运行都可以
Private Sub Command1_Click()
Dim objExcelApp As Object, objSheet As Object
Dim objCADApp As Object, objDoc As Object
Dim pointName As String, pointX As Double, pointY As Double
Dim txtP(2) As Double, txtH As Double, pLine() As Double
Set objExcelApp = GetObject(, "Excel.Application") '获得系统中运行的EXCEL
Set objSheet = objExcelApp.ActiveWorkbook.ActiveSheet '返回当前活动工作表
Set objCADApp = GetObject(, ".Application") '获得系统中运行的cad
Set objDoc = objCADApp.ActiveDocument '返回当前活动
s = 2 '电子表格数据开始行
e = 80 '结束行
txtH = 0.0001 '文字高度
n = (e - s + 1) * 2 - 1 '计算多段线需要的数组大小
ReDim pLine(n) '定义多段线数组
For i = 2 To 80
pointName = objSheet.cells(i, 1) '读取坐标点名（A列）
pointX = objSheet.cells(i, 2) '读取坐标点经度（b列）
pointY = objSheet.cells(i, 3) '读取坐标点纬度（c列）
txtP(0) = pointX
txtP(1) = pointY
pLine(j) = pointX
pLine(j + 1) = pointY
j = j + 2
Call objDoc.ModelSpace.AddText(pointName, txtP, txtH) '添加坐标点名称
Next
Call objDoc.ModelSpace.AddLightWeightPolyline(pLine) '绘制多段线
End Sub
本帖以下内容被隐藏保护；需要你回复后，才能看到！ 游客，如果您要查看本帖隐藏内容请 回复 |
|
置顶卡
