按电子表格中的坐标绘图（免费源代码）
工作中碰到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
**** Hidden Message ***** 下图是根据这个代码写的一个完整版绘图工具，功能是按坐标自动绘制配电线路图
下来看看 源码不全，
test.exe
---------------------------
运行时错误 '429':
ActiveX 部件不能创建对象
---------------------------
确定
---------------------------
谢谢分享学习了
页:
[1]