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

qindong

数据库按
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]),1
(slope[2])->sa
(slope[3])->ya1
(slope[7])->sb

If x≥sa and x≤sb and sign(y)=sign(ya1) Then
(slope[4])->ha1
(slope[5])->ya2
(slope[6])->ha2
(slope[8])->yb1
(slope[9])->hb1
(slope[10])->yb2
(slope[11])->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:[email protected]"
Disp "(C)SurMap.com 2015"

Goto tlbar

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

Lbl quit
Disp "Ended by user!"
EndPrgm

永远的0

然而并没有下载链接