cad平台上测绘中VBA展野外点点号与方位角.docVIP

下面就是自动在AutoCAD中画点的Visual Basic程序代 码(部分),最后将其制作成可执行文件(e: \展点.exe)供 AutoCAD菜单宏调用。 假若数据采集格式为: 点号,X坐标,Y坐标, Z(高程) Open数据文件名For Input As #1 set Points = acdoc.Layers.Add(/点0)-增加/点0图层 Points.Color = acBlue Set Heights = acdoc.Layers.Add(/高程0)-增加/高程0图层 Heights.Color = acGreen Set nos = acdoc.Layers.Add(/点号0) -增加/点号0图层 nos.Color = acRed Do While Not EOF(1) Input #1, NO, x, y, z -将文件中数据分别附值 给这几个变量 Pt(0) = y: Pt(1) = x: Pt(2) = 0 -测量坐标系与 AutoCAD坐标系的区别 Set AdPoint = modelobj.AddPoint(Pt) -在模型空间中画点 AdPoint.Layer =/点0 SetAdNO = modelobj.AddText(Str(NO), Pt, 1#)-在模型空 间中绘制点号 AdNO.Layer =/点号0 Ht(0) = y + 0.9: Ht(1) = x: Ht(2) = 0 Set AdHeight = modelobj.AddText(Str(z), Ht, 2#) AdHeight.Layer =/高程0 Loop Close #1 acapp1.Application.ZoomExtents Form1.Visible = False End Sub 将展成的点连线的VBA代码为: Set PtLine = ThisDrawing.Layers.Add(/点连线0) PtLine.color = acCyan Dim k Dim Coord As Variant For Each entry In ThisDrawing.ModelSpace If entry.EntityType = acPoint Then i = i + 1 End If Next -获取模型空间中的点数目 ReDim entrycopys(i -1, 2) -根据获得的点数目重新定义 数组维数 k = 0 For Each entry In ThisDrawing.ModelSpace If entry.EntityType = acPoint Then Coord = entry.Coordinates -获取实体坐标 entrycopys(k, 0) = Coord (0) entrycopys(k, 1) = Coord (1) entrycopys(k, 2) = Coord (2) k = k + 1 End If Next Dim StPt(0 To 2) As Double Dim EtPt(0 To 2) As Double For j = 1 To i -1 StPt(0) = entrycopys(j -1, 0) StPt(1) = entrycopys(j -1, 1) StPt(2) = entrycopys(j -1, 2) EtPt(0) = entrycopys(j, 0) EtPt(1) = entrycopys(j, 1) EtPt(2) = entrycopys(j, 2) Set Lines = ThisDrawing.ModelSpace.AddLine(StPt, EtPt)-将当 前点与前一个点连线 Lines.Layer =/点连线0 Next j ThisDrawing.Application.ZoomExtents 如果要在Visual Basic环境中写入程序,则只要将VBA中的 ThisDrawing对象改为AutoCAD对象的活动文件对象,就可以执 行相同的操作,但由于是外部程序,执行速度将会慢一些。再 将程序写成一个可执行文件(.exe)供AutoCAD菜单宏调用。 （1）在数字化成图方面的应用 应用 VBA 二次开发技术可以实现坐标展点、建立 ATM 模型、绘制等值线、生成本 单位实际需要的图框等工作的自动化、批处理。下面的例子能够实现在 CAD 下展绘高程 点功能。假设高程点文件结构（南方 CASS 的*.dat 格式）为： “点号 1，点属性名 1，X 坐标 1，Y 坐标 1，高程 1 点号 2，点属性名 2，X 坐标 2，Y 坐标 2，高程 2 …… …… ……” 以下面 zgcd 子程序