;;該程序繪制波速測試成果圖


;;方正書宋簡體-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 該程序結束 !!!")