qindong 发表于 2016-10-12 20:06:59

发一个测量用计算边坡开挖计算的程序

数据库按
sa1,ya1,ha1,ya2,ha2,sb1,yb1,hb1,yb2,hb2定义一个面,省略两个重复的桩号

源代码:

a_kwslop()
Prgm
ClrIO
ClrHome
0->x
0->y
0->z
0->ok
Lbl tlbar
Toolbar
Title "Calc"
Item "Slope Xalculation",calc
Item "Display input",dspinput
Item "Display result",dsprslt
Title "control"
Item "Quit",quit
Title "help"
Item "Introduction",intro
Item "About",about
EndTBar

Lbl calc
ClrIO
ClrHome
0->x
0->y
0->z
0->ok
Input "Stage:?",x
Input "Offset:?",y
Input "Level(≤0:end):?",z

If z≤0 Then
Goto end
EndIf

For i,1,dim(slope),1
(slope)->sa
(slope)->ya1
(slope)->sb

If x≥sa and x≤sb and sign(y)=sign(ya1) Then
(slope)->ha1
(slope)->ya2
(slope)->ha2
(slope)->yb1
(slope)->hb1
(slope)->yb2
(slope)->hb2

finvalue(sa,ya1,sb,yb1,x)->yp1
finvalue(sa,ya2,sb,yb2,x)->yp2
finvalue(sa,ha1,sb,hb1,x)->hp1
finvalue(sa,ha2,sb,hb2,x)->hp2
finvalue(yp1,hp1,yp2,hp2,y)->hp0
finvalue(hp1,yp1,hp2,yp2,z)->yp0

If z≥hp1 and z≤hp2 Then
ok+1->ok
If y<0 Then
yp0-y->dy
Else
y-yp0->dy
EndIf
EndIf

If abs(y)≥abs(yp1) and abs(y)≤abs(yp2) Then
ok+2->ok
hp0-z->dh
EndIf
EndIf

If ok=3 Then
Goto exitfor
EndIf
EndFor

Lbl exitfor
If ok=0 Then
Disp "Out of database!"
EndIf

If ok=1 Then
ClrIO
Disp "["&format(x,"f3")&","&format(y,"f3")&","&format(z,"f3")&"]"
Disp "y(-Qian,+Chao):"&format(dy,"f3")
EndIf

If ok=2 Then
ClrIO
Disp "["&format(x,"f3")&","&format(y,"f3")&","&format(z,"f3")&"]"
Disp "h(-Qian,+Chao):"&format(dh,"f3")
EndIf

If ok=3 Then
ClrIO
Disp "["&format(x,"f3")&","&format(y,"f3")&","&format(z,"f3")&"]"
Disp "y(-Qian,+Chao):"&format(dy,"f3")
Disp "h(-Qian,+Chao):"&format(dh,"f3")
EndIf

Goto tlbar

Lbl dspinput
ClrIO
Disp "["&format(x,"f3")&","&format(y,"f3")&","&format(z,"f3")&"]"
Goto tlbar

Lbl dsprslt
If ok=0 Then
ClrIO
Disp "No calculation!"
EndIf

If ok=1 Then
ClrIO
Disp "["&format(x,"f3")&","&format(y,"f3")&","&format(z,"f3")&"]"
Disp "y(-Qian,+Chao):"&format(dy,"f3")
EndIF

If ok=2 Then
ClrIO
Disp "["&format(x,"f3")&","&format(y,"f3")&","&format(z,"f3")&"]"
Disp "h(-Qian,+Chao):"&format(dh,"f3")
EndIf

If ok=3 Then
ClrIO
Disp "["&format(x,"f3")&","&format(y,"f3")&","&format(z,"f3")&"]"
Disp "y(-Qian,+Chao):"&format(dy,"f3")
Disp "h(-Qian,+Chao):"&format(dh,"f3")
EndIf
Goto tlbar

Lbl about
ClrHome
ClrIO
Disp "SlopeCalculation V150823"
Disp "By:QinDong QQ:61902475"
Disp "Tel:139 *"
Disp "Email:cehui@139.com"
Disp "(C)SurMap.com 2015"

Goto tlbar

Lbl intro
ClrHome
ClrIO
Disp "-Qian,+Chao"
Goto tlbar

Lbl quit
Disp "Ended by user!"
EndPrgm

永远的0 发表于 2017-3-29 12:14:21

然而并没有下载链接
页: [1]
查看完整版本: 发一个测量用计算边坡开挖计算的程序