李华忠
(安徽省宿州市勘测规划设计院,安徽宿州234000)
对沉降收敛曲线自动绘制的完善
李华忠
(安徽省宿州市勘测规划设计院,安徽宿州234000)
对高层建筑物进行全面的、系统的、长期的沉降监测,发现异常,即时分析原因,采取补救措施,对于确保高层建筑物在施工期间和投入运营后的安全,具有非常重要的意义。
变量声明;荷载线;AcadApplication
以前我单位画沉降收敛曲线,是通过EXCEL图表功能生成,曲线做出来不仅不美观,而且没有荷载线。如果通过CAD绘制,速度有点慢。于是本人编制了一套VB程序,使已有的EXCEL数据自动的,批量的转为CAD格式的沉降收敛曲线图形。
如图1所示。

图1
如图2所示。
Dim AcadApp As AcadApplication
Dim plineObj1 As AcadLWPolyline
Dim plineObj2 As AcadLWPolyline
Dim points()As Double
Dim points1()As Double
Dim points2(0 To 3)As Double
Dim points3(0 To 7)As Double
Set AcadApp=CreateObject("AutoCAD.Application")
Dim CJexcel1 As Excel.Application
Dim CJbook1 As Excel.Workbook
Dim CJsheet1 As Excel.Worksheet
Dim CJsheet2 As Excel.Worksheet
Set CJexcel1=CreateObject("excel.application")
points1(X)=(CJsheet2.Cells(i+1,m+1).Value)/10
points1(X+1)=i+80*(j-1)
SetplineObj1 = AcadApp.ActiveDocument.ModelSpace.Ad⁃dLightWeightPolyline(points1)
points2(0)=FD1:points2(1)=FD2
points2(2)=80:points2(3)=FD2
SetplineObj2 = AcadApp.ActiveDocument.ModelSpace.Ad⁃dLightWeightPolyline(points2)
For i=1 To CC
TextString=Fix(i*HengXianBiaoZhu)
points2(0)=0:points2(1)=i+80*(j-1)
points2(2)=0.5:points2(3)=i+80*(j-1)
InserPiont(0)=-1#:InserPiont(1)=i+0.2+80*(j-1):InserPiont(2)=0
Set TextObj1=AcadApp.ActiveDocu⁃ment.ModelSpace.AddText(TextString,Inser⁃Piont,Height)
SetplineObj2=AcadApp.ActiveDocu⁃ment.ModelSpace.AddLightWeightPolyline(points2)
Next i
For i=1 To GuanCeQiShuo
k=4*i-3
CJsheet2.Cells(i+1,m)=CJsheet1.Cells(1,k+1)
litestriQi=CDate(CJsheet1.Cells(1,k+1))
litestriQi2=CDate(CJsheet1.Cells(1,2))
CJsheet2.Cells(i+1,m+1)=DateValue(CJsheet1.Cells(1,k+1))-DateValue(CJsheet1.Cells(1,2))
CJRQshuozu(i)=CJsheet1.Cells(1,k+1)
CJsheet2.Cells(i+1,m+3)=CJsheet1.Cells(j+2,k)
DianMing=CJsheet1.Cells(j+2,k)
If CJsheet1.Cells(j+2,k+3)=""And i<> 1 Then
CJsheet2.Cells(i+1,m+2)=CJsheet2.Cells(i,m+2)
Else
CJsheet2.Cells(i+1,m+2)=CJsheet1.Cells(j+2,k+3)
End If
points(X)=(CJsheet2.Cells(i+1,m+1).Value)/10:points(X+1)=-(CJsheet2.Cells(i+1,m+2).Value)+80*(j-1)
If i<=FengDingCiShuo Then
points1(X)=(CJsheet2.Cells(i+1,m+1).Value)/10:points1(X+1)=i+80*(j-1)
FD1=points1(X)
FD2=points1(X+1)
Else
End If
X=2*i
CJshuozu1(i)=Val(CJsheet2.Cells(i+1,m+1).Value)/10
Next i
Set plineObj=AcadApp.ActiveDocument.ModelSpace.Ad⁃dLightWeightPolyline(points)
沉降监测是一项精密的工程测量,由于工作多,任务重,时间要求紧,如果利用常规方法,保质保量按时完成任务,难度很大。限于此因,我做了这个与沉降监测工作配套的程序,极大提高了工作效率。此软件已在工作中使用很长时间了,迄今为止运行稳定,性能、效果良好。
[1]赛奎春,李俊民.Visual Basic函数参考大全[M].人民邮电出版社,2007.
[2]顾孝烈.测量学[M].4版.同济大学出版社,2012.
[3]黄声享.变形监测数据处理[M].武汉大学出版社,2010.
TP393
A
1009-3044(2017)24-0185-02
2017-06-26