bosu.lsp

波速测试CAD画图 工程物探波速测试 希望大家能喜欢

;;该程序绘制波速测试成果图


;;方正书宋简体-fzssjw.ttf 黑体-simhei.ttf 楷体_GB2312-simkai.ttf 仿宋_GB2312-simfang.ttf


;;变量输入、赋值

(command "style" "stylehz_12" "simhei.ttf" 0 1.2 0 "n" "n")
(command "style" "styletxt12" "txt" 0 1.2 0 "n" "n" "n")
(command "style" "stylehz_10" "simhei.ttf" 0 0.8 0 "n" "n")
(command "style" "styletxt10" "txt" 0 1.0 0 "n" "n" "n")
(command "style" "stylehz_09" "simhei.ttf" 0 0.9 0 "n" "n")
(command "style" "styletxt09" "txt" 0 0.9 0 "n" "n" "n")
(command "style" "stylehz_08" "simhei.ttf" 0 0.8 0 "n" "n")
(command "style" "styletxt08" "txt" 0 0.8 0 "n" "n" "n")
(command "style" "stylehz_07" "simhei.ttf" 0 0.7 0 "n" "n")
(command "style" "styletxt07" "txt" 0 0.7 0 "n" "n" "n")


(command "layer" "n" "WT波速测试图层" "c" 7 "WT波速测试图层" "")
(command "layer" "s" "WT波速测试图层" "")

(princ "\n ---该程序绘制波速测试成果图---")

(setq fi (getfiled "选择一个波速测试数据文件" "" "txt" 7))
(setq fp (open fi "r"))

(setq map (read-line fp))
(setq map (read map))
(setq maptitle0 (nth 0 map))

(if(="图名、比例尺字符" maptitle0) 
(princ "\n程序正常运行到读取图名段")
(princ "\n程序没有正常运行到读取图名段")
)

(setq maptitle1 (nth 1 map))
(setq maptitle2 (nth 2 map))

(setq mapdepth (read-line fp))
(setq mapdepth (read mapdepth))
(setq mapdepth0 (nth 0 mapdepth))

(if(="钻孔深度、比例因子" mapdepth0) 
(princ "\n程序正常运行到读取钻孔深度段")
(princ "\n程序没有正常运行到读取钻孔深度段")
)
(setq mapdepth1 (nth 1 mapdepth))
(setq mapdepth2 (nth 2 mapdepth))

(setq h mapdepth1)
(setq s0 mapdepth2) 

(setq h0 (/(* h 1000) s0))

(setq xx1 45 xx2 55 xx3 75 xx4 85 xx5 105 xx6 115 xx7 125 xx8 135 xx9 150 y1 8)
(setq y2 (+ y1 h0))
(setq x1 10 x2 25 x3 40 x4 80 x5 150 y3 (+ y1 h0 10))


(setq vsb 10 tsb 5)


(princ "\n 你选择了绘制图框!!!")

;;线型、字体选择
(command "linetype" "s" "bylayer" "")

;;图形框架
(command "rectang" (list 0 0) (list xx1 y1))
(command "rectang" (list xx1 0) (list xx2 y1))
(command "rectang" (list xx2 0) (list xx3 y1))
(command "rectang" (list xx3 0) (list xx4 y1))
(command "rectang" (list xx4 0) (list xx5 y1))
(command "rectang" (list xx5 0) (list xx6 y1))
(command "rectang" (list xx6 0) (list xx7 y1))
(command "rectang" (list xx7 0) (list xx8 y1))
(command "rectang" (list xx8 0) (list xx9 y1))
(command "rectang" (list 0 y2) (list x1 y3))
(command "rectang" (list x1 y2) (list x2 y3))
(command "rectang" (list x2 y2) (list x3 y3))
(command "rectang" (list x3 y2) (list x4 y3))
(command "rectang" (list x4 y2) (list x5 y3))
(command "rectang" (list 0 y1) (list x1 y2))
(command "rectang" (list x1 y1) (list x2 y2))
(command "rectang" (list x2 y1) (list x3 y2))
(command "rectang" (list x3 y1) (list x4 y2))
(command "rectang" (list x4 y1) (list x5 y2))

(command "pline" (list 0.0 0.0) "w" 1 "" (list xx9 0.0) (list xx9 y3) (list 0.0 y3) "c")

;;图头
(setq p0 (list (/(+ 0 x5) 2.0) (+ 12 y3)))
(command "text" "s" "stylehz_10" "j" "mc" p0 4.0 0 maptitle1)
(setq p0 (list (/(+ 0 x5) 2.0) (+ 6 y3)))
(command "text" "s" "stylehz_10" "j" "mc" p0 5.0 0 maptitle2)

;;表头
(setq p0 (list (/ x1 2.0) (+(*(/(- y3 y2) 3.0) 2.0) y2)))
(command "text" "s" "stylehz_10" "j" "mc" p0 2.0 0 "深 度")

(setq p0 (list (+(/(- x2 x1) 2.0) x1) (+(*(/(- y3 y2) 3.0) 2.0) y2)))
(command "text" "s" "stylehz_10" "j" "mc" p0 2.0 0 "钻  孔")
(setq p0 (list (+(/(- x2 x1) 2.0) x1) (+(*(/(- y3 y2) 3.0) 1.0) y2)))
(command "text" "s" "stylehz_10" "j" "mc" p0 2.0 0 "柱状图")

(setq p0 (list (+(/(- x3 x2) 2.0) x2) (+(*(/(- y3 y2) 3.0) 2.0) y2)))
(command "text" "s" "stylehz_10" "j" "mc" p0 2.0 0 "岩   土")
(setq p0 (list (+(/(- x3 x2) 2.0) x2) (+(*(/(- y3 y2) 3.0) 1.0) y2)))
(command "text" "s" "stylehz_10" "j" "mc" p0 2.0 0 "名   称")

(setq p0 (list (+(/(- x4 x3) 2.0) x3) (+(*(/(- y3 y2) 3.0) 2.0) y2)))
(command "text" "s" "stylehz_10" "j" "mc" p0 2.0 0 "波     速")

(setq p0 (list (+(/(- x5 x4) 2.0) x4) (+(*(/(- y3 y2) 3.0) 2.0) y2)))
(command "text" "s" "stylehz_10" "j" "mc" p0 2.0 0 "时    程    曲    线")

;;责任表

(setq p0 (list (/(+ 0 xx1) 2.0) (/(+ 0 y1) 2.0)))
(command "text" "s" "stylehz_08" "j" "mc" p0 3.0 0 "四川地质工程测试研究所")

(setq p0 (list (+(/(- xx2 xx1) 2.0) xx1) (/(+ 0 y1) 2.0)))
(command "text" "s" "stylehz_08" "j" "mc" p0 3.0 0 "拟编")

(setq p0 (list (+(/(- xx4 xx3) 2.0) xx3) (/(+ 0 y1) 2.0)))
(command "text" "s" "stylehz_08" "j" "mc" p0 3.0 0 "审查")

(setq p0 (list (+(/(- xx6 xx5) 2.0) xx5) (/(+ 0 y1) 2.0)))
(command "text" "s" "stylehz_08" "j" "mc" p0 3.0 0 "比例尺")

(setq p0 (list (+(/(- xx8 xx7) 2.0) xx7) (/(+ 0 y1) 2.0)))
(command "text" "s" "stylehz_08" "j" "mc" p0 3.0 0 "日期")

(setq p0 (list (+(/(- xx3 xx2) 2.0) xx2) (/(+ 0 y1) 2.0)))
;;(princ "请输入图件拟编人：")
(command "text" "s" "stylehz_10" "j" "mc" p0 3.0 0 "袁仕维")

(setq p0 (list (+(/(- xx5 xx4) 2.0) xx4) (/(+ 0 y1) 2.0)))
;;(princ "\n请输入图件审查人：")
(command "text" "s" "stylehz_10" "j" "mc" p0 3.0 0 "熊军")

(setq p0 (list (+(/(- xx7 xx6) 2.0) xx6) (/(+ 0 y1) 2.0)))
;;(princ "请输入图号：")
(command "text" "s" "stylehz_10" "j" "mc" p0 3.0 0 "1:100")

(setq p0 (list (+(/(- xx9 xx8) 2.0) xx8) (/(+ 0 y1) 2.0)))
;;(princ "请输入制图日期：")
(command "text" "s" "stylehz_08" "j" "mc" p0 2.5 0 "2007年10月")

;;恢复AUTOCAD默认线型
(command "linetype" "s" "bylayer" "")

(setq p0 (list (/ x1 2.0) (+(*(/(- y3 y2) 3.0) 1.0) y2)))
(command "text" "s" "styletxt08" "j" "mc" p0 2.0 0 "(m)")

(command "line" (list (+ x3 10) y2) (list (+ x3 (* vsb 1.0)) (- y2 1))"")
(command "text" "s" "styletxt08" "j" "tc" (list (+ x3 (* vsb 1.0)) (- y2 1)) 1.5 0 "0.5")
(command "line" (list (+ x3 20) y2) (list (+ x3 (* vsb 2.0)) (- y2 1))"")
(command "text" "s" "styletxt08" "j" "tc" (list (+ x3 (* vsb 2.0)) (- y2 1)) 1.5 0 "1.0")
(command "line" (list (+ x3 30) y2) (list (+ x3 (* vsb 3.0)) (- y2 1))"")
(command "text" "s" "styletxt08" "j" "tc" (list (+ x3 (* vsb 3.0)) (- y2 1)) 1.5 0 "1.5")
(command "text" "s" "styletxt08" "j" "tc" (list (+ x3 (* vsb 3.5)) (- y2 1)) 1.5 0 "(Km/s)")

(setq p0 (list (+(/(- x4 x3) 2.0) x3) (+(*(/(- y3 y2) 3.0) 1.0) y2)))
(command "text" "s" "stylehz_10" "j" "mc" p0 1.5 0 "(Vp: ───      Vs: - - -)")

(command "line" (list (+ x4 5) y2) (list (+ x4 (* tsb 1.0)) (- y2 1))"")
(command "text" "s" "styletxt08" "j" "tc" (list (+ x4 (* tsb 1.0)) (- y2 1)) 1.5 0 "10")
(command "line" (list (+ x4 10) y2) (list (+ x4 (* tsb 2.0)) (- y2 1))"")
(command "text" "s" "styletxt08" "j" "tc" (list (+ x4 (* tsb 2.0)) (- y2 1)) 1.5 0 "20")
(command "line" (list (+ x4 15) y2) (list (+ x4 (* tsb 3.0)) (- y2 1))"")
(command "text" "s" "styletxt08" "j" "tc" (list (+ x4 (* tsb 3.0)) (- y2 1)) 1.5 0 "30")
(command "line" (list (+ x4 20) y2) (list (+ x4 (* tsb 4.0)) (- y2 1))"")
(command "text" "s" "styletxt08" "j" "tc" (list (+ x4 (* tsb 4.0)) (- y2 1)) 1.5 0 "40")
(command "line" (list (+ x4 25) y2) (list (+ x4 (* tsb 5.0)) (- y2 1))"")
(command "text" "s" "styletxt08" "j" "tc" (list (+ x4 (* tsb 5.0)) (- y2 1)) 1.5 0 "50")
(command "line" (list (+ x4 30) y2) (list (+ x4 (* tsb 6.0)) (- y2 1))"")
(command "text" "s" "styletxt08" "j" "tc" (list (+ x4 (* tsb 6.0)) (- y2 1)) 1.5 0 "60")
(command "line" (list (+ x4 35) y2) (list (+ x4 (* tsb 7.0)) (- y2 1))"")
(command "text" "s" "styletxt08" "j" "tc" (list (+ x4 (* tsb 7.0)) (- y2 1)) 1.5 0 "70")
(command "line" (list (+ x4 40) y2) (list (+ x4 (* tsb 8.0)) (- y2 1))"")
(command "text" "s" "styletxt08" "j" "tc" (list (+ x4 (* tsb 8.0)) (- y2 1)) 1.5 0 "80")
(command "line" (list (+ x4 45) y2) (list (+ x4 (* tsb 9.0)) (- y2 1))"")
(command "text" "s" "styletxt08" "j" "tc" (list (+ x4 (* tsb 9.0)) (- y2 1)) 1.5 0 "90")
(command "line" (list (+ x4 50) y2) (list (+ x4 (* tsb 10.0)) (- y2 1))"")
(command "text" "s" "styletxt08" "j" "tc" (list (+ x4 (* tsb 10.0)) (- y2 1)) 1.5 0 "100")
(command "text" "s" "styletxt08" "j" "tc" (list (+ x4 (* tsb 12.0)) (- y2 1)) 1.5 0 "(ms)")
(setq p0 (list (+(/(- x5 x4) 2.0) x4) (+(*(/(- y3 y2) 3.0) 1.0) y2)))
(command "text" "s" "stylehz_10" "j" "mc" p0 1.5 0 "(tp: ───          ts: - - -)")




(princ "\n 你选择了绘制岩土分层线")

;;线型、字体选择
(command "linetype" "s" "bylayer" "")


(setq mapytc (read-line fp))
(setq mapytc (read mapytc))
(setq mapytc0 (nth 0 mapytc))
(if(="岩土分层数、以下是岩土层层底深度及岩土层名称" mapytc0) 
(princ "\n程序正常运行到读取岩土分层段\n")
(princ "\n!!!程!序!没!正!常!运!行!到!读!取!岩!土!分!层!段!!!")
)
(setq mapn (nth 1 mapytc))

;;画分层线

(setq n (- mapn 1))
(setq hh1 0)
(
while (> n 0)

(setq mapytc (read-line fp))
(setq mapytc (read mapytc))
(setq mapytcdp (nth 0 mapytc))
(setq mapytcna (nth 1 mapytc))

(setq hh mapytcdp)
(setq hh0 (/(* hh 1000) s0))

;;填写深度、岩性

(setq p0 (list (+(/ x1 2.0) 0) (- y2 hh0)))
(command "text" "s" "styletxt08" "j" "bc" p0 1.6 0 (rtos hh 2 2))
(command "line" (list 0 (- y2 hh0)) (list x3 (- y2 hh0)) "")

(setq p0 (list (+(/(- x3 x2) 2.0) x2) (+(- y2 hh0) (/(- hh0 hh1) 2.0))))
(command "text" "s" "stylehz_10" "j" "mc" p0 2.0 0 mapytcna)

(setq hh1 hh0)
(setq n (- n 1))
)

(setq mapytc (read-line fp))
(setq mapytc (read mapytc))
(setq mapytcdp (nth 0 mapytc))
(setq mapytcna (nth 1 mapytc))

(setq hh0 h0)
(setq p0 (list (+(/(- x3 x2) 2.0) x2) (+(- y2 hh0) (/(- hh0 hh1) 2.0))))
(command "text" "s" "stylehz_10" "j" "mc" p0 2.0 0 mapytcna)


(princ "\n 你选择了绘制纵波有关曲线\n")

(setq mapbst (read-line fp))
(setq mapbst (read mapbst))
(setq mapjc (nth 0 mapbst))
(setq mappyj (nth 1 mapbst))

(if(="振源距孔口距离，以下是纵波接收点深度、走时" mapjc) 
(princ "\n程序正常运行到读取纵波数据段\n")
(princ "\n!!!程!序!没!有!正!常!运!行!到!读!取!纵!波!数!据!段!!!")
)

(setq ds mappyj)

;;线型选择
(command "linetype" "s" "bylayer" "")

;;时距曲线
;;tp
(setq dh0 0.0 dh 0.0 dh1 0.0 dt0 0.0 dt 0.0 dt1 0.0)
(setq pl0 (list x4 y2))
(setq pv0 (list x3 y2))

(setq mapbst (read-line fp))
(setq mapbst (read mapbst))
(setq mapbstdp (nth 0 mapbst))
(setq mapbstt (nth 1 mapbst))
(setq dh mapbstdp)

(
while (< dh h)
(setq dt mapbstt)
(setq dt1 (*(/ dh (sqrt(+(expt ds 2.0) (expt dh 2.0)))) dt))

;;绘制时距曲线
(setq pl1 (list (+ x4 (/ dt1 (/ 10.0 tsb))) (- y2 (/(* dh 1000) s0))))
(command "line" pl0 pl1 "")
(setq pl0 pl1)

;;绘制速度曲线
(setq dv (*(/(* (- dh dh0)2) (- dt1 dt0)) vsb))
(setq pv (list (+ x3 dv) (- y2 (/(* dh0 1000) s0))))
(setq pv1 (list (+ x3 dv) (- y2 (/(* dh 1000) s0))))
(command "line" pv0 pv pv1 "")
(setq pv0 pv1)
(setq dh0 dh)
(setq dt0 dt1)

(setq mapbst (read-line fp))
(setq mapbst (read mapbst))
(setq mapbstdp (nth 0 mapbst))
(setq dh mapbstdp)
(
if (< dh h)
(setq mapbstt (nth 1 mapbst))
)
)

(princ "\n 你选择了绘制横波有关曲线\n")


(setq mapbst (read-line fp))
(setq mapbst (read mapbst))
(setq mapjc (nth 0 mapbst))
(setq mappyjl0 (nth 1 mapbst))

(if(="振源距孔口距离，以下是横波接收点深度、走时" mapjc) 
(princ "\n程序正常运行到读取剪切波数据段\n")
(princ "\n!!!程!序!没!有!正!常!运!行!到!读!取!剪!切!波!数!据!段!!!")
)

(setq ds mappyjl0)

;;线型选择
(command "linetype" "s" "HIDDEN2" "")


;;时距曲线
;;ts
(setq dh0 0.0 dh 0.0 dh1 0.0 dt0 0.0 dt 0.0 dt1 0.0)
(setq pl0 (list x4 y2))
(setq pv0 (list x3 y2))

(setq mapbst (read-line fp))
(setq mapbst (read mapbst))
(setq mapbstdp (nth 0 mapbst))
(setq mapbstt (nth 1 mapbst))
(setq dh mapbstdp)

(
while (< dh h)
(setq dt mapbstt)
(setq dt1 (*(/ dh (sqrt(+(expt ds 2.0) (expt dh 2.0)))) dt))

;;绘制时距曲线
(setq pl1 (list (+ x4 (/ dt1 (/ 10.0 tsb))) (- y2 (/(* dh 1000) s0))))
(command "line" pl0 pl1 "")
(setq pl0 pl1)

;;绘制速度曲线
(setq dv (*(/ (* (- dh dh0)2) (- dt1 dt0)) vsb))
(setq pv (list (+ x3 dv) (- y2 (/(* dh0 1000) s0))))
(setq pv1 (list (+ x3 dv) (- y2 (/(* dh 1000) s0))))
(command "line" pv0 pv pv1 "")
(setq pv0 pv1)
(setq dh0 dh)
(setq dt0 dt1)

(setq mapbst (read-line fp))
(setq mapbst (read mapbst))
(setq mapbstdp (nth 0 mapbst))
(setq dh mapbstdp)
(
if (< dh h)
(setq mapbstt (nth 1 mapbst))
)
)

;;恢复AUTOCAD默认值
(command "linetype" "s" "bylayer" "")

(command "layer" "s" "0" "")

(princ "\n 该程序结束 !!!")