利用高程点生成断面数据vba程序

《利用高程点生成断面数据vba程序》由会员上传分享，免费在线阅读，更多相关内容在行业资料-天天文库。

1、利用高程点生成断面数据VBA程序。主要应用于水渠与道路方面的横断面数据提取，现为生成格式为纬地与重庆测绘院的断面格式。其实格式可以自己设定，需要帮助联系QQ：365149174.  具体请各自测试。。。PublicSubnumssg1ok()  '生成中桩水平单及横断面数据  DimtextAsAcadText,text1AsAcadText,text2AsAcadText  DimobjectAsAcadEntity  Dimstr1AsString,str2AsString  DimfpathAsString,filepathAsString  Dimse

2、lpointAsAcadSelecti**et,selpAsAcadSelecti**et  DimobjeAsAcadEntity  DimpointAsVariant,point1AsVariant  DimlinAsAcadLine  DimdisAsDouble  DimhiAsDouble  DimhisAsDouble  Dimp(0To2)AsDouble,p1(0To2)AsDouble  DimfipathAsString  DimttstrAsString  DimiAsDouble  Dimfipatha1AsString  Dimtts

3、tra1AsString  OnErrorResumeNextDimnumAsStringDimfilepath1AsStringfpath="F:纵断面.txt"filepath1="F:绘图横断面.txt"fipath="F:纬地设计方横断面.txt"fipatha1="F:横断面原始数据.txt"  OpenfpathForAppendAs#2  Openfilepath1ForAppendAs#1OpenfipathForAppendAs#3Openfipatha1ForAppendAs#4100:i=0Err.Number=0  ThisDr

4、awing.Utility.GetEntityobject,selset**creen,"请选择中桩里程:"IfErr.Number<>0ThenGoTo200  Settext=object  str1=text.TextString    Print#1,str1  Print#1,"Z"  Err.Number=0  ThisDrawing.Utility.GetEntityobject,selset**creen,"请选择对应中桩高程:"'IfErr.Number<>0ThenGoTo200  Settext1=object  str2=text1.T

5、extString  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**ets.Item("选择文本对象")  IfErr.Number<>0Then  '如果“选择文本对象”选项已经存在，则删除它      Err.Clear      Setselpoint=ThisDrawing.Sel

6、ecti**ets.Add("选择文本对象")  EndIf  selpoint.Clear  selpoint.Select**creen  IfErr.Number<>0Then  '如果选择点错误，重新再选      Err.Clear      GoTo200  EndIf    ForEachobjeInselpoint  Ifobje.ObjectName="AcDbText"Then    Settext2=obje    i=i+1      point1=text2.InsertionPoint      p1(0)=point1(0)   

7、   p1(1)=point1(1)      p1(2)=0      Setlin=ThisDrawing.ModelSpace.AddLine(p,p1)      dis=lin.Length      lin.Delete      hi=Val(text2.TextString)-Val(text1.TextString)      his=Val(text2.TextString)        Print#1,Format(dis,"0.0")+","+Format(hi,"0.00")        Ifi=1Thenttstr=ttstr+

8、Format(dis,"0.0")+"