资源描述：
《利用高程点生成断面数据vba程序》由会员上传分享，免费在线阅读，更多相关内容在行业资料-天天文库。
1、利用高程点生成断面数据VBA程序。主要应用于水渠与道路方面的横断面数据提取，现为生成格式为纬地与重庆测绘院的断面格式。其实格式可以自己设定，需要帮助联系QQ：365149174. 具体请各自测试。。。PublicSubnumssg1ok() '生成中桩水平单及横断面数据 DimtextAsAcadText,text1AsAcadText,text2AsAcadText DimobjectAsAcadEntity Dimstr1AsString,str2AsString DimfpathAsString,f
2、ilepathAsString DimselpointAsAcadSelecti**et,selpAsAcadSelecti**et DimobjeAsAcadEntity DimpointAsVariant,point1AsVariant DimlinAsAcadLine DimdisAsDouble DimhiAsDouble DimhisAsDouble Dimp(0To2)AsDouble,p1(0To2)AsDouble DimfipathAsString DimttstrAsStrin
3、g DimiAsDouble Dimfipatha1AsString Dimttstra1AsString OnErrorResumeNextDimnumAsStringDimfilepath1AsStringfpath="F:纵断面.txt"filepath1="F:绘图横断面.txt"fipath="F:纬地设计方横断面.txt"fipatha1="F:横断面原始数据.txt" OpenfpathForAppendAs#2 Openfilepath1ForAppendAs#1Openfipat
4、hForAppendAs#3Openfipatha1ForAppendAs#4100:i=0Err.Number=0 ThisDrawing.Utility.GetEntityobject,selset**creen,"请选择中桩里程:"IfErr.Number<>0ThenGoTo200 Settext=object str1=text.TextString Print#1,str1 Print#1,"Z" Err.Number=0 ThisDrawing.Utility.GetEntityobj
5、ect,selset**creen,"请选择对应中桩高程:"'IfErr.Number<>0ThenGoTo200 Settext1=object str2=text1.TextString point=text1.InsertionPoint p(0)=point(0) p(1)=point(1) p(2)=0 ttstr=str1&vbCrLf ttstra1=str1+"/"+str2 Err.Number=0 Setselpoint=ThisDrawing.Selecti**e
6、ts.Item("选择文本对象") IfErr.Number<>0Then '如果“选择文本对象”选项已经存在，则删除它 Err.Clear Setselpoint=ThisDrawing.Selecti**ets.Add("选择文本对象") EndIf selpoint.Clear selpoint.Select**creen IfErr.Number<>0Then '如果选择点错误，重新再选 Err.Clear GoTo200 EndIf ForEac
7、hobjeInselpoint Ifobje.ObjectName="AcDbText"Then Settext2=obje i=i+1 point1=text2.InsertionPoint p1(0)=point1(0) p1(1)=point1(1) p1(2)=0 Setlin=ThisDrawing.ModelSpace.AddLine(p,p1) dis=lin.Length lin.Delete hi=Val(
8、text2.TextString)-Val(text1.TextString) his=Val(text2.TextString) Print#1,Format(dis,"0.0")+","+Format(hi,"0.00") Ifi=1Thenttstr=ttstr+Format(dis,"0.0")+"
