发一个测量用计算边坡开挖计算的程序
数据库按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:[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
然而并没有下载链接
页:
[1]