(defun newqbct ()


  (setq dt1 (atof (nth 4 zhb)))
  (setq dt2 0)
  (setq dt (/ (atof (nth 11 zhb)) 100))

  (if (/= lsdtb nil)
    (progn
      (setq dtbl (nth 2 lsdtb))
      (if (/= dtbl "自动")
	(setq dtbl (atof dtbl))
      )
    )
;;;endprogn
  )
;;;endif 

  (setq dtbl (atof dtblc))


  (if (<= dtbl 0)

    (progn
      (setq js nil)


      (setq i  0
	    ch (/ (length bgb) 5)
      )
      (repeat ch			;repeat 00000000000000000000000000000
	(setq a (nth i bgb))
	(if (= (nth 28 gcwzb) "1")
	  (setq a (nth (+ i 4) bgb))
	)
	(setq js (append js (list (atof a))))
	(setq i (+ i 5))
      )
;;;;end repeat


      (setq i  0
	    ch (/ (length zeb) 5)
      )
      (repeat ch			;repeat 00000000000000000000000000000
	(setq a (nth i zeb))
	(if (= (nth 28 gcwzb) "1")
	  (setq a (nth (+ i 4) zeb))
	)
	(setq j	   1
	      k	   1
	      zejs nil
	)
	(while (>= (- (strlen a) j) 0)
	  (setq js1 (substr a j 2))
	  (setq js2 (substr a j 1))
	  (if (= js1 "，")
	    (setq zejs (append zejs (list (substr a k (- j k))))
		  k    (+ j 2)
	    )
	  )
	  (if (= js2 ",")
	    (setq zejs (append zejs (list (substr a k (- j k))))
		  k    (+ j 1)
	    )
	  )
	  (setq j (1+ j))
	)
	;;endwhilen
	(setq zejs (append zejs (list (substr a k (- j k)))))
	(setq n 0)
	(repeat	(length zejs)
	  (setq js (append js (list (atof (nth n zejs)))))
	  (setq n (1+ n))
	)
	;;endrepeat
	(setq i (+ i 5))
      )
;;;;end repeat

      (setq i 0)
      (while (<= i (1- (length lsdtb)))
	(progn
	  (if (= (nth i lsdtb) "连续动力触探类型：")
	    (setq i (+ i 5))
	  )
;;;endif
	  (setq js (append js (list (atof (nth i lsdtb)))))
	  (setq i (1+ i))
	)
      )
;;;end if
      (setq i 0
	    jsmax 0
      )
      (repeat (length js)
	(if (< jsmax (nth i js))
	  (setq jsmax (nth i js))
	)
	(setq i (1+ i))
      )
      (if (> (- (/ jsmax 4) (fix (/ jsmax 4))) 0.5)
	(setq a 1)
	(setq a 0.5)
      )
      (if (and (= (/ jsmax 4) (fix (/ jsmax 4)))
	       (> (fix (/ jsmax 4)) 0)
	  )
	(setq a 0)
      )
      (setq dtbl (+ a (fix (/ jsmax 4))))

    )
;;;endprogn
  )
;;;end if

  (setq	x 13.7
	i 1
  )
  (repeat 3
    (setq p1 (list x 22.4))
    (setq x (1+ x))
    (setq txt1 (rtos (* dtbl i) 2 1))
    (setq i (1+ i))
    (command "_.text" "s" "style1" "m" p1 0.2 0 txt1)
  )

  (setq x (+ 0.03 x))
  (setq p1 (list x 22.4))
  (setq txt1 (itoa (fix (+ (atof txt1) (/ dtbl 2)))))
  (setq txt1 (strcat ">" txt1))
  (command "_.text" "s" "style1" "mr" p1 0.2 0 txt1)




  (if (/= lsdtb nil)
    (setq txt1 (strcat (nth 1 lsdtb) "曲线图(击)"))
    (setq txt1 "动探曲线图(击)")
  )
  (command "_.text" "s" "style1" "m" "14.7,23.5" 0.33 0 txt1)

  (if (/= lsdtb nil)
    (progn
      (command "_.color" "blue")
      (setq i 0)
      (while (< i (length lsdtb))
	(if (= (nth i lsdtb) "连续动力触探类型：")
	  (setq	y  (- 22 (/ (atof (nth (+ i 4) lsdtb)) dt))
		dy (/ (atof (nth (+ i 3) lsdtb)) dt 100)
		i  (+ i 5)
	  )
	)
	(command "_.line" (list 12.7 y))
	(while (and (< i (length lsdtb))
		    (/= (nth i lsdtb) "连续动力触探类型：")
	       )
	  (setq	a    (nth i lsdtb)
		txt1 ""
	  )
	  (setq j 1)
	  (while (>= (- (strlen a) j) 3)
	    (setq ft (substr a j 4))
	    (if	(= ft "反弹")
	      (setq txt1 "反弹")
	    )
	    (setq j (1+ j))
	  )

	  (setq x (+ 12.7 (/ (atof (nth i lsdtb)) dtbl)))
	  (setq xx x)
	  (if (> xx 16.65)
	    (setq x 16.15)
	  )
	  (setq p1 (list x y))
	  (command p1)
	  (if (= txt1 "反弹")
	    (progn
	      (setq p3 (list 16.15 y))
	      (command p3)
	      (setq p1 (list 12.7 y))
	      (command p1 "")
	      (command "_.color" "bylayer")
	      (command "_.text" "s" "style1" "ml" p3 0.23 0 "反弹")
	      (setq txt1 "")
	      (command "_.color" "blue")
	    )
	    ;;endprogn
	    (progn
	      (if (<= xx 16.65)
		(progn
		  (setq y (- y dy))
		  (setq p1 (list x y))
		  (command p1)
		)
;;;endprogn
		(progn
		  (command "")
		  (setq p3 (list 16.65 (- y (/ dy 2))))
		  (command "_.color" "bylayer")
		  (command "_.text"
			   "s"
			   "style1"
			   "mr"
			   p3
			   0.23
			   0
			   (rtos (atof (nth i lsdtb)) 2 1)
		  )
		  (command "_.color" "blue")
		  (setq y (- y dy))
		  (setq p1 (list x y))
		  (command "_.line" p1)
		)
;;;endprogn
	      )
;;;end if
	    )
;;;endprogn
	  )
;;;endif	
	  (setq i (1+ i))
	)
;;;end whilen
	(setq p1 (list 12.7 y))
	(command p1 "")
      )
;;;endwhilew
    )
;;;endprogn
  )

)




;;;begin  read-data-function "readfile(filename listname)"从工程文件中读出1、工程地质剖面 。2、单页柱状中所绘制的钻孔名称 。3、读出钻孔综合数据的函数
;;;begin  read-data-function "readfile(filename listname)"从工程文件中读出1、工程地质剖面 。2、单页柱状中所绘制的钻孔名称 。3、读出钻孔综合数据的函数
;;;begin  read-data-function "readfile(filename listname)"其中filename为工程所在位置，包括路径及工程文件名，
;;;begin  read-data-function "readfile(filename listname)"其中listname为要读出的数据表的标志字符串，如3、钻孔综合数据为"**zk1"等，zk1为钻孔编号，其结果得到单个钻孔的综合数据表如zk1、zk2等等
;;;begin  read-data-function "readfile(filename listname)"其中listname为要读出的数据表的标志字符串，如2、单页柱状中所绘制的钻孔为"**zzt"等，zzt表示柱状图，其结果得到一个表zzt，所包含的一系列子表为各张钻孔柱状图所包含的钻孔及左右顺序
;;;begin  read-data-function "readfile(filename listname)"其中listname为要读出的数据表的标志字符串，如1、工程地质剖面为"**pmt"等，pmt表示剖面图，其结果得到一个表，所包含的一系列子表为各单张剖面图所包含的钻孔编号、孔口标高、最大孔深、在剖面中的位置、水平比例及垂直比例
(defun readfile	(e g)
  (setq ff (open e "r"))
  (setq b ())
  (setq a t)
  (while (/= a "**end")			;while1
    (setq a (read-line ff))
    (if	(= a g)				;if1
      (while (/= a "**end")		;while2
	(setq a (read-line ff))
	(if (/= (substr a 1 2) "**")	;if2
	  (setq b (append b (list a)))
	  (setq a "**end")
	)				;if2
      )					;end while2
    )					;end while1
  )					;end if1
  (close ff)
  (setq c b)
)
;;;end  read-data-function "readfile(filename listname)"从工程文件中读出1、工程地质剖面 。2、单页柱状中所绘制的钻孔名称 。3、读出钻孔综合数据的函数
;;;end   read-data-function "readfile(filename listname)"其中filename为工程所在位置，包括路径及工程文件名，
;;;end   read-data-function "readfile(filename listname)"其中listname为要读出的数据表的标志字符串，如3、钻孔综合数据为"**zk1"等，zk1为钻孔编号，其结果得到单个钻孔的综合数据表如zk1、zk2等等
;;end   read-data-function "readfile(filename listname)"其中listname为要读出的数据表的标志字符串，如2、单页柱状中所绘制的钻孔为"**zzt"等，zzt表示柱状图，其结果得到一个表zzt，所包含的一系列子表为各张钻孔柱状图所包含的钻孔及左右顺序
;;end   read-data-function "readfile(filename listname)"其中listname为要读出的数据表的标志字符串，如1、工程地质剖面为"**pmt"等，pmt表示剖面图，其结果得到一个表，所包含的一系列子表为各单张剖面图所包含的钻孔编号、孔口标高、最大孔深、在剖面中的位置、水平比例及垂直比例


;;;begin  read-data-function "readfile1(filename)"
;;;begin  read-data-function "readfile1(filename)"
;;;begin  read-data-function "readfile1(filename)"
;;;begin  read-data-function "readfile1(filename)"
(defun readfile1 (g)
  (setq ff (open g "r"))
  (setq b ())
  (setq	a nil
	j 0
  )
  (while (< j 50)			;while1
    (setq a (read-line ff))
    (if	(/= a nil)			;if2
      (setq b (append b (list a))
	    j 0
      )
      (setq j (1+ j))
    )					;if2
  )					;end while1
  (close ff)
  (setq c b)
)					;end read-data-function "readfile1(filename)"
					;end read-data-function "readfile1(filename)"
					;end read-data-function "readfile1(filename)"

(setq gcwzb (apply 'readfile1 (list "c:/Gees2000/gcwz.txt")))
























(defun getbzyxb	(filename)
;;;;begin defun  getbzyxb(filename)    return after sorted bzyxb
;;;;begin defun  getbzyxb(filename)    return after sorted bzyxb
;;;;begin defun  getbzyxb(filename)    return after sorted bzyxb
;;;;begin defun  getbzyxb(filename)    return after sorted bzyxb

;;;subfunction1;;;;end defun  getbzyxb(filename)
;;;subfunction1 begin  read-data-function "readfile3(filename)"
;;;subfunction1 begin  read-data-function "readfile3(filename)"
;;;subfunction1 begin  read-data-function "readfile3(filename)"
  (defun readfile3 (filename)
    (setq ff (open filename "r"))
    (setq b ())
    (setq bzyxbbj nil)
    (setq a nil
	  j 0
	  bzyxbbj ""
    )
    (while (< j 50)			;while1
      (setq a (read-line ff))
      (setq p "")
      (if (/= a nil)
	(setq p a)
      )
      (if (= (substr p 1 2) "**")
	(setq bzyxbbj (substr a 3))
      )
      (if (and (/= a nil) (/= a "") (/= (substr a 1 2) "**")) ;if2
	(setq b	(append b (list a))
	      j	0
	)
	(setq j (1+ j))
      )					;if2
    )					;end while1
    (close ff)
    (setq c b)
  )					;end subfunction1 read-data-function "readfile3(filename)"
					;end subfunction1 read-data-function "readfile3(filename)"
					;end subfunction1 read-data-function "readfile3(filename)"
					;end subfunction1 read-data-function "readfile3(filename)"
					;end subfunction1 read-data-function "readfile(filename)"
					;end subfunction1 read-data-function "readfile(filename)"
					;end subfunction1 read-data-function "readfile(filename)"




;;; subfunction2 对字符串表如标准岩性名称表由多至少进行排序
;;; subfunction2 调用形式为：(setq bzyxb1 (apply 'pszhc (list bzyxb)))
;;; subfunction2 其中bzyxb为欲排序的字符串表，调用该函数后返回排序的的一个新表如bzyxb1
;;; subfunction2 局部变量分别为(a / b c d e f i g1 j1 g h)
  (defun pszhc (a)
    (setq g (length a))
    (setq c a)
    (setq b nil)
    (repeat g

      (setq g1 (length c))
      (repeat g1
	(setq j1 0)
	(setq f (nth 0 c))
	(while (< j1 (1- g1))
	  (setq j1 (1+ j1))
	  (if (< (strlen f) (strlen (nth j1 c)))
	    (setq f (nth j1 c))
	  )
	)				;end while (< j1 g1)
      )					;end repeat g1

      (setq b (append b (list f)))
      (setq i 0)
      (setq d ())
      (while (< i (length c))
	(if (/= (nth i c) f)
	  (setq d (append d (list (nth i c))))
	)				;endif
	(setq i (1+ i))
      )					;end while
      (setq c d)
    )
    (setq e b)
  )					;end defun
;;; subfunction2 排序pszhc定义结束
;;; subfunction2 排序pszhc定义结束
;;; subfunction2 排序pszhc定义结束
;;; subfunction2 排序pszhc定义结束
;;; subfunction2 排序pszhc定义结束



;;;;;; subfunction3 write bzyxb3 to "c:/Gees2000/标准岩土名称.txt"writeflie3(a b)function
;;;;;; subfunction3 write bzyxb3 to "c:/Gees2000/标准岩土名称.txt"writeflie3(a b)function
;;;;;; subfunction3 write bzyxb3 to "c:/Gees2000/标准岩土名称.txt"writeflie3(a b)function
;;;;;; subfunction3 write bzyxb3 to "c:/Gees2000/标准岩土名称.txt"writeflie3(a b)function
;;;;;; subfunction3 write bzyxb3 to "c:/Gees2000/标准岩土名称.txt"writeflie3(a b)function

  (defun writefile3 (a b)
    (setq ff (open b "w"))
    (setq i 0
	  s (strcat "\n" "**" (itoa (length a)))
    )
    (repeat (length a)
      (setq c (strcat "\n" (nth i a)))
      (setq i (1+ i))
      (princ c ff)
    )					;end repeat
    (princ s ff)
    (close ff)
  )
;;; subfunction3 end defun writefile3(a b)write bzyxb3 to "c:/Gees2000/标准岩土名称.txt"writeflie3(a b)function
;;; subfunction3 end defun writefile3(a b)write bzyxb3 to "c:/Gees2000/标准岩土名称.txt"writeflie3(a b)function


  (setq bzyxb3 (apply 'readfile3 (list filename)))
  (if (/= bzyxbbj (itoa (length bzyxb3)))
    (progn
      (setq bzyxb3 (apply 'pszhc (list bzyxb3)))
      (apply 'writefile3 (list bzyxb3 filename))
    )					;end progn
  )					;endif
  (setq a bzyxb3)
)
;;;;end defun  getbzyxb(filename)
;;;;end defun  getbzyxb(filename)
;;;;end defun  getbzyxb(filename)
;;;;end defun  getbzyxb(filename)








(defun zzttkfun	()
;;;;;
  (command "_.pline" "0.05,0" "w" 0.07 "" "16.95,0" "16.95,26" "0.05,26"
	   "c")
  (command "_.pline" "0.05,0.7" "w" 0.013 "" "16.95,0.7" "")
  (command "_.pline" "3.15,0" "w" 0.013 "" "3.15,0.7" "")
  (command "_.text"	"s"	     "style1"	  "m"
	   "1.65,0.35"	0.23	     0		  "钻 孔 柱 状 图"
	  )
  (command "_.pline" "4.15,0" "w" 0.013 "" "4.15,0.7" "")
  (command "_.text" "s"	"style1" "m" "3.65,0.35" 0.23 0	"编 制")
  
  (command "_.pline" "5.95,0" "w" 0.013 "" "5.95,0.7" "")
  (command "_.text" "s"	"style1" "m" "6.45,0.35" 0.23 0	"复 核")
  (command "_.pline" "6.95,0" "w" 0.013 "" "6.95,0.7" "")
  (command "_.pline" "8.75,0" "w" 0.013 "" "8.75,0.7" "")
  (command "_.text" "s"	"style1" "m" "9.25,0.35" 0.23 0	"审 核")
  (command "_.pline" "9.75,0" "w" 0.013 "" "9.75,0.7" "")
  (command "_.pline" "11.55,0" "w" 0.013 "" "11.55,0.7" "")
  (command "_.text" "s"	"style1" "m" "12.05,0.35" 0.23 0 "图表号")
  (setq txt1 (nth 15 gcgkb))
  (command "_.text" "s" "style1" "m" "13.45,0.35" 0.23 0 txt1)

  (command "_.pline" "12.55,0" "w" 0.013 "" "12.55,0.7" "")
  (command "_.pline" "14.35,0" "w" 0.013 "" "14.35,0.7" "")
  (setq tkym (strcat "第" (itoa zzth) "页" " " "共" (itoa zym) "页"))
  (command "_.text" "s" "style1" "m" "15.75,0.35" 0.23 0 tkym)
  (setq tjymh tkym)

  
;;;;;;
  (command "_.rectang" "w" 0.0 "0.3,1" "16.7,24.8")
  (command "_.pline" "0.3,22" "w" 0.03 "" "16.7,22" "")
  (command "_.pline" "1.3,1" "w" 0.013 "" "1.3,24.8" "")
  (command "_.text" "s"	"style11" "m" "0.8,23.4" 270 "成因符号或分层号")
  (command "_.pline" "2.3,1" "w" 0.013 "" "2.3,22" "")
  (command "_.pline" "2.3,22.6" "w" 0.013 "" "2.3,24.8" "")
  (command "_.text" "s"	"style11" "m" "1.8,23.7" 270 "层底深度")
  (command "_.pline" "3.3,1" "w" 0.013 "" "3.3,22" "")
  (command "_.pline" "3.3,22.6" "w" 0.013 "" "3.3,24.8" "")
  (command "_.text" "s"	"style11" "m" "2.8,23.7" 270 "层    厚")
  (command "_.pline" "4.3,1" "w" 0.013 "" "4.3,24.8" "")
  (command "_.text" "s"	"style1" "m" "3.8,24.1595" 0.23	0 "层底")
  (command "_.text" "s"	"style1" "m" "3.8,23.2237" 0.23	0 "标高")
  (command "_.pline" "1.3,22.6" "w" 0.013 "" "4.3,22.6" "")
  (command "_.text" "s" "style1" "m" "2.8,22.3" 0.23 0 "(m)")
  (command "_.pline" "5.2,1" "w" 0.013 "" "5.2,22" "")
  (command "_.pline" "5.4,1" "w" 0.013 "" "5.4,22" "")
  (command "_.pline" "6.3,1" "w" 0.013 "" "6.3,24.8" "")
  (command "_.text" "s"	"style1" "m" "5.3,24.1"	0.23 0 "柱状剖面")
  (command "_.text" "s"	"style1" "m" "5.3,23.4"	0.23 0 "比 例 尺")
  (command "_.text" "s"	"style1" "m" "5.3,22.7"	0.23 0 "1：   ")
  (command "_.pline" "10.3,1" "w" 0.013 "" "10.3,24.8" "")
  (command "_.text"	"s"	     "style1"	  "m"
	   "8.3,23.4"	0.23	     0		  "岩（土）层工程地质描述"
	  )
  (command "_.pline" "11,1" "w" 0.013 "" "11,24.8" "")
  (command "_.text" "s"	"style11" "m" "10.65,23.4" 270 "状态  或  密度")
  (command "_.pline" "11.7,1" "w" 0.013 "" "11.7,24.8" "")
  (command "_.text" "s"	"style11" "m" "11.35,23.4" 270 "含  水  量  ％")
  (command "_.pline" "12.7,1" "w" 0.013 "" "12.7,24.8" "")
  (command "_.text" "s"	"style1" "m" "12.2,24.24" 0.23 0 "容许")
  (command "_.text" "s"	"style1" "m" "12.2,23.68" 0.23 0 "承载")
  (command "_.text" "s" "style1" "m" "12.2,23.12" 0.23 0 "力")
  (command "_.text" "s"	"style1" "m" "12.2,22.56" 0.23 0 "kpa")
  (command "_.pline" "13.7,22" "w" 0.013 "" "13.7,22.1" "")
  (command "_.pline" "14.7,22" "w" 0.013 "" "14.7,22.1" "")
  (command "_.pline" "15.7,22" "w" 0.013 "" "15.7,22.1" "")

;;;;
;;;;
(command "_.text" "s" "style1" "ml" "0.75,25.78" 0.23 0	"工程名称：")
(command "_.text" "s" "style1" "ml" "0.75,25.38" 0.23 0	"钻孔编号：")
(command "_.text" "s" "style1" "ml" "0.75,25.02" 0.23 0	"钻孔座标：")
					;
(command "_.text" "s" "style1" "ml" "2.2488,25.02" 0.23	0 "X=")
(command "_.text" "s" "style1" "ml" "4.6475,25.02" 0.23	0 "Y=")
					;
(command "_.text" "s" "style1" "ml" "8,25.78" 0.23 0 "钻孔位置：")
(command "_.text"     "s"	   "style1"	"ml"
	 "7.52,25.38" 0.23	   0		"孔口高程(m)："
	)
					;
(command "_.text" "s" "style1" "ml" "12.28,25.78" 0.23 0 "开孔日期：")
(command "_.text" "s" "style1" "ml" "12.28,25.38" 0.23 0 "终孔日期：")
					;
(command "_.text" "s" "style1" "ml" "14.4284,25.78" 0.23 0 "年")
  (command "_.text" "s"	"style1" "ml" "14.4284,25.38" 0.23 0 "年")
  (command "_.text" "s"	"style1" "ml" "15.1182,25.78" 0.23 0 "月")
  (command "_.text" "s"	"style1" "ml" "15.1182,25.38" 0.23 0 "月")
  (setq plotstyle "zztA4")		;
  (command "_.text" "s"	"style1" "ml" "15.8081,25.78" 0.23 0 "日")
  (command "_.text" "s"	"style1" "ml" "15.8081,25.38" 0.23 0 "日")
;;;
;;;
;;;
  ;;
)					;end defun zzttkfun















;;;;;;绘制左侧柱状图函数zzt1fun(zk)
;;;;;绘制左侧柱状图函数zzt1fun(zk)
;;;;;其中 zk为柱状图数据表
;;;;;其中 zk为柱状图数据表
;;;;;其中 zk为柱状图数据表
(defun zzt1fun (zk bzyxb)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;***********************************************************************************************
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;***********************************************************************************************

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;***********************************************************************************************

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;***********************************************************************************************

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;***********************************************************************************************





;;;;;;;从岩性描述中查找对应的岩性花纹函数qdyx(a b)
;;;;;;; 其中a为已定义好的标准岩性名称表；b为岩性描述字符串
;;;;;;;该函数返回确定后的岩性名称
;;;;;;;函数的调用方法：  (setq yx (apply 'qdyx (list bzyxb1 yxms)))
;;;;;;;yx为返回的岩性名称字符串变量,若表a中无相应名称的岩性则函数返回""
(defun qdyx (a b)
  (setq	i 0
	j t
  )
  (while (and (< i (length a)) j)
    (setq c (nth i a))
    (setq l1 (strlen c))
    (setq i1 0)
    (while (and (< i1 38) j)
      (setq i1 (1+ i1))
      (if (/= (substr b i1 1) nil)
	(if (or (= (substr b i1 2) "：") (= (substr b i1 1) ":"))
	  (setq i1 10000)
	)
      )					;endif
      (setq d (substr b i1 l1))
      (if (= c d)
	(setq j nil)
      )
    )					;end while(and (< i1 16)j)
    (setq i (1+ i))
  )					;end while(and (< i (length bzyxb1))j)
  (if j
    (setq e "")
    (setq e c)
  )
)
;;;;;;;end defun确定岩性名称函数qdyx(a b)
;;;;;;;end defun确定岩性名称函数qdyx(a b)
;;;;;;;end defun确定岩性名称函数qdyx(a b)
;;;;;;;end defun确定岩性名称函数qdyx(a b);
;;;;;;;end defun确定岩性名称函数qdyx(a b)
;;;;;;;end defun确定岩性名称函数qdyx(a b)
;;;;;;;end defun确定岩性名称函数qdyx(a b)
;;;;;;;end defun确定岩性名称函数qdyx(a b)
;;;;;;;end defun确定岩性名称函数qdyx(a b)
;;;;;;;end defun确定岩性名称函数qdyx(a b)
;;;;;;;end defun确定岩性名称函数qdyx(a b)
;;;;;;;end defun确定岩性名称函数qdyx(a b)
;;;;;;;end defun确定岩性名称函数qdyx(a b)
;;;;;;;end defun确定岩性名称函数qdyx(a b)
;;;;;;;从岩性描述中查找对应的岩性花纹函数qdyx(a b)
;;;;;;; 其中a为已定义好的标准岩性名称表；b为岩性描述字符串
;;;;;;;该函数返回确定后的岩性名称
;;;;;;;函数的调用方法：  (setq yx (apply 'qdyx (list bzyxb1 yxms)))
;;;;;;;yx为返回的岩性名称字符串变量,若表a中无相应名称的岩性则函数返回""
  (defun qdyxm (a b)
  (setq	i 0
	j t
  )
  (while (and (< i (length a)) j)
    (setq c (nth i a))
    (setq l1 (strlen c))
    (setq i1 0)
    (while (and (< i1 28) j)
      (setq i1 (1+ i1))
      (if (/= (substr b i1 1) nil)
	(if (or (= (substr b i1 2) "：") (= (substr b i1 1) ":"))
	  (setq i1 50)
	)
      )					;endif
      (setq d (substr b i1 l1))
      (if (and (= c d)
	       (/= c "全风化")
	       (/= c "强风化")
	       (/= c "中风化")
	       (/= c "弱风化")
	       (/= c "微风化")
	  )
	(setq j nil)
      )
    )					;end while(and (< i1 16)j)
    (setq i (1+ i))
  )					;end while(and (< i (length bzyxb1))j)
  (if j
    (setq e "")
    (setq e c)
  )
)







  (defun huawentc (bzyxb3 yxms ks1 ks2)	;defunhuawentc (bzyxb3 yxms ks1 ks2)00000000000000000000000000000000000000000000000000
					;defunhuawentc (bzyxb3 yxms ks1 ks2)00000000000000000000000000000000000000000000000000
					;defunhuawentc (bzyxb3 yxms ks1 ks2)00000000000000000000000000000000000000000000000000
					;defunhuawentc (bzyxb3 yxms ks1 ks2)00000000000000000000000000000000000000000000000000
					;defunhuawentc (bzyxb3 yxms ks1 ks2)00000000000000000000000000000000000000000000000000
					;defunhuawentc (bzyxb3 yxms ks1 ks2)00000000000000000000000000000000000000000000000000
					;defunhuawentc (bzyxb3 yxms ks1 ks2)00000000000000000000000000000000000000000000000000
					;defunhuawentc (bzyxb3 yxms ks1 ks2)00000000000000000000000000000000000000000000000000
					;defunhuawentc (bzyxb3 yxms ks1 ks2)00000000000000000000000000000000000000000000000000
					;defunhuawentc (bzyxb3 yxms ks1 ks2)00000000000000000000000000000000000000000000000000
					;defunhuawentc (bzyxb3 yxms ks1 ks2)00000000000000000000000000000000000000000000000000
(setq bzyxb1 '("全风化"	   "强风化"    "中风化"	   "弱风化"
	       "微风化"	   "粗砂"      "中砂"	   "细砂"
	       "粉砂"	   "根植土"    "种植土"	   "圆砾"
	       "砾砂"
	      )
)
    (setq yx nil)
    (setq yx (apply 'qdyx (list bzyxb1 yxms)))
    (cond
      ((or (= yx "全风化")
	   (= yx "强风化")
	   (= yx "中风化")
	   (= yx "弱风化")
	   (= yx "微风化")
       )
       (progn				;progn1
	 (setq fileyx (strcat "c:/Gees2000/岩土花纹/" yx))
	 (setq fileyx1 (strcat "c:/Gees2000/岩土花纹/" yx ".dwg"))
	 (if (findfile fileyx1)		;if1111111111111111111111111
	   (progn			;progn111111111111
	     (if (<= ks2 21)		;if101 101 101 101
	       (if (< (/ (- ks2 ks1) 1.3) 1.5) ;if1
		 (progn	;;progn1
			(setq m (- ks2 ks1))
			(setq p1 (list 4.75 (- 22 ks1 (/ m 2)))
			      p2 (list 5.85 (- 22 ks1 (/ m 2)))
			)
			(command "_.minsert" fileyx p1 1 1 "" 1 1)
			(command "_.minsert" fileyx p2 1 1 "" 1 1)
		 )			;endprogn1
		 (progn			;progn2
		   (setq n (fix (/ (- ks2 ks1) 1.3)))
		   (if (= n 1)
		     (setq n 2)
		   )
		   (setq m (/ (- ks2 ks1) n))
		   (setq p1 (list 4.75 (- 22 ks1 (/ m 2)))
			 p2 (list 5.85 (- 22 ks1 (/ m 2)))
		   )
		   (setq m1 (- 0 m))
		   (command "_.minsert" fileyx p1 1 1 "" n 1 m1)
		   (command "_.minsert" fileyx p2 1 1 "" n 1 m1)
		 )			;endprogn2
	       )			;end if1
	     )				;end if101 101 101 101 101
	     (if (>= ks1 21)		;if102 102 102 102 102 102
	       (if (< (/ (- ks2 ks1) 1.3) 1.5) ;if1
		 (progn	;;progn1
			(setq m (- ks2 ks1))
			(setq p1 (list 23.15 (- 43 ks1 (/ m 2)))
			      p2 (list 24.25 (- 43 ks1 (/ m 2)))
			)
			(command "_.minsert" fileyx p1 1 1 "" 1 1)
			(command "_.minsert" fileyx p2 1 1 "" 1 1)
		 )			;endprogn1
		 (progn			;progn2
		   (setq n (fix (/ (- ks2 ks1) 1.3)))
		   (if (= n 1)
		     (setq n 2)
		   )
		   (setq m (/ (- ks2 ks1) n))
		   (setq p1 (list 23.15 (- 43 ks1 (/ m 2)))
			 p2 (list 24.25 (- 43 ks1 (/ m 2)))
		   )
		   (setq m1 (- 0 m))
		   (command "_.minsert" fileyx p1 1 1 "" n 1 m1)
		   (command "_.minsert" fileyx p2 1 1 "" n 1 m1)
		 )			;endprogn2
	       )			;end if1
	     )				;end if102  102 102 102 102
	     (if (and (< ks1 21) (> ks2 21)) ;if103 103 103 103)
	       (progn			;progn103 103 103 103
		 (if (< (/ (- 21 ks1) 1.3) 1.5) ;if1
		   (progn ;;progn1
			  (setq m (- 21 ks1))
			  (setq	p1 (list 4.75 (- 22 ks1 (/ m 2)))
				p2 (list 5.85 (- 22 ks1 (/ m 2)))
			  )
			  (command "_.minsert" fileyx p1 1 1 "" 1 1)
			  (command "_.minsert" fileyx p2 1 1 "" 1 1)
		   )			;endprogn1
		   (progn		;progn2
		     (setq n (fix (/ (- 21 ks1) 1.3)))
		     (if (= n 1)
		       (setq n 2)
		     )
		     (setq m (/ (- 21 ks1) n))
		     (setq p1 (list 4.75 (- 22 ks1 (/ m 2)))
			   p2 (list 5.85 (- 22 ks1 (/ m 2)))
		     )
		     (setq m1 (- 0 m))
		     (command "_.minsert" fileyx p1 1 1 "" n 1 m1)
		     (command "_.minsert" fileyx p2 1 1 "" n 1 m1)
		   )			;endprogn2
		 )			;end if1
		 (if (< (/ (- ks2 21) 1.3) 1.5) ;if2
		   (progn ;;progn1
			  (setq m (- ks2 21))
			  (setq	p1 (list 23.15 (- 22 (/ m 2)))
				p2 (list 24.25 (- 22 (/ m 2)))
			  )
			  (command "_.minsert" fileyx p1 1 1 "" 1 1)
			  (command "_.minsert" fileyx p2 1 1 "" 1 1)
		   )			;endprogn1
		   (progn		;progn2
		     (setq n (fix (/ (- ks2 21) 1.3)))
		     (if (= n 1)
		       (setq n 2)
		     )
		     (setq m (/ (- ks2 21) n))
		     (setq p1 (list 23.15 (- 22 (/ m 2)))
			   p2 (list 24.25 (- 22 (/ m 2)))
		     )
		     (setq m1 (- 0 m))
		     (command "_.minsert" fileyx p1 1 1 "" n 1 m1)
		     (command "_.minsert" fileyx p2 1 1 "" n 1 m1)
		   )			;endprogn2
		 )			;end if2
	       )			;endprogn103 103 103 103
	     )				;end if103 03 103 103 103
	   )				;endprogn111111111111111111
	 )				;endif11111111111111111111111

       )				;endprogn1
      )					;3



((= yx "砾砂")
  (progn				;progn1
    (setq m (- ks2 ks1))
    (if	(<= ks2 21)			;if2
      (setq p1 (list 4.75 (- 22 ks1 (/ m 2)))
	    p2 (list 5.85 (- 22 ks1 (/ m 2)))
      )
    )					;end if2
    (if	(> ks1 21)
      (setq p1 (list 23.15 (- 43 ks1 (/ m 2)))
	    p2 (list 24.25 (- 43 ks1 (/ m 2)))
      )
    )
    (if	(and (> ks2 21) (< ks1 21))
      (progn
	(setq m (- 21 ks1))
	(setq p1 (list 4.75 (- 22 ks1 (/ m 2)))
	      p2 (list 5.85 (- 22 ks1 (/ m 2)))
	)
	(setq m (- ks2 21))
	(setq p3 (list 23.15 (- 22 (/ m 2)))
	      p4 (list 24.25 (- 22 (/ m 2)))
	)
	(command "_.text" "s" "style1" "m" p3 0.16 0 "(L)")
	(command "_.text" "s" "style1" "m" p4 0.16 0 "(L)")
      )					;endprogn
    )					;endif
    (command "_.text" "s" "style1" "m" p1 0.16 0 "(L)")
    (command "_.text" "s" "style1" "m" p2 0.16 0 "(L)")
  )					;end progn1	
)					;6


      ((= yx "粗砂")
       (progn				;progn1
	 (setq m (- ks2 ks1))
	 (if (<= ks2 21)		;if2
	   (setq p1 (list 4.75 (- 22 ks1 (/ m 2)))
		 p2 (list 5.85 (- 22 ks1 (/ m 2)))
	   )
	 )				;end if2
	 (if (> ks1 21)
	   (setq p1 (list 23.15 (- 43 ks1 (/ m 2)))
		 p2 (list 24.25 (- 43 ks1 (/ m 2)))
	   )
	 )
	 (if (and (> ks2 21) (< ks1 21))
	   (progn
	     (setq m (- 21 ks1))
	     (setq p1 (list 4.75 (- 22 ks1 (/ m 2)))
		   p2 (list 5.85 (- 22 ks1 (/ m 2)))
	     )
	     (setq m (- ks2 21))
	     (setq p3 (list 23.15 (- 22 (/ m 2)))
		   p4 (list 24.25 (- 22 (/ m 2)))
	     )
	     (command "_.text" "s" "style1" "m" p3 0.16 0 "(c)")
	     (command "_.text" "s" "style1" "m" p4 0.16 0 "(c)")
	   )				;endprogn
	 )				;endif
	 (command "_.text" "s" "style1" "m" p1 0.16 0 "(c)")
	 (command "_.text" "s" "style1" "m" p2 0.16 0 "(c)")
       )				;end progn1	
      )					;6

      ((= yx "中砂")
       (progn				;progn1
	 (setq m (- ks2 ks1))
	 (if (<= ks2 21)		;if2
	   (setq p1 (list 4.75 (- 22 ks1 (/ m 2)))
		 p2 (list 5.85 (- 22 ks1 (/ m 2)))
	   )
	 )				;end if2
	 (if (> ks1 21)
	   (setq p1 (list 23.15 (- 43 ks1 (/ m 2)))
		 p2 (list 24.25 (- 43 ks1 (/ m 2)))
	   )
	 )
	 (if (and (> ks2 21) (< ks1 21))
	   (progn
	     (setq m (- 21 ks1))
	     (setq p1 (list 4.75 (- 22 ks1 (/ m 2)))
		   p2 (list 5.85 (- 22 ks1 (/ m 2)))
	     )
	     (setq m (- ks2 21))
	     (setq p3 (list 23.15 (- 22 (/ m 2)))
		   p4 (list 24.25 (- 22 (/ m 2)))
	     )
	     (command "_.text" "s" "style1" "m" p3 0.16 0 "(z)")
	     (command "_.text" "s" "style1" "m" p4 0.16 0 "(z)")
	   )				;endprogn
	 )				;endif

	 (command "_.text" "s" "style1" "m" p1 0.16 0 "(z)")
	 (command "_.text" "s" "style1" "m" p2 0.16 0 "(z)")
       )				;end progn1	
      )					;7

      ((= yx "细砂")
       (progn				;progn1
	 (setq m (- ks2 ks1))
	 (if (<= ks2 21)		;if2
	   (setq p1 (list 4.75 (- 22 ks1 (/ m 2)))
		 p2 (list 5.85 (- 22 ks1 (/ m 2)))
	   )
	 )				;end if2
	 (if (> ks1 21)
	   (setq p1 (list 23.15 (- 43 ks1 (/ m 2)))
		 p2 (list 24.25 (- 43 ks1 (/ m 2)))
	   )
	 )
	 (if (and (> ks2 21) (< ks1 21))
	   (progn
	     (setq m (- 21 ks1))
	     (setq p1 (list 4.75 (- 22 ks1 (/ m 2)))
		   p2 (list 5.85 (- 22 ks1 (/ m 2)))
	     )
	     (setq m (- ks2 21))
	     (setq p3 (list 23.15 (- 22 (/ m 2)))
		   p4 (list 24.25 (- 22 (/ m 2)))
	     )
	     (command "_.text" "s" "style1" "m" p3 0.16 0 "(x)")
	     (command "_.text" "s" "style1" "m" p4 0.16 0 "(x)")
	   )				;endprogn
	 )				;endif
	 (command "_.text" "s" "style1" "m" p1 0.16 0 "(x)")
	 (command "_.text" "s" "style1" "m" p2 0.16 0 "(x)")
       )				;end progn1	
      )					;8

      ((= yx "粉砂")
       (progn				;progn1
	 (setq m (- ks2 ks1))
	 (if (<= ks2 21)		;if2
	   (setq p1 (list 4.75 (- 22 ks1 (/ m 2)))
		 p2 (list 5.85 (- 22 ks1 (/ m 2)))
	   )
	 )				;end if2
	 (if (> ks1 21)
	   (setq p1 (list 23.15 (- 43 ks1 (/ m 2)))
		 p2 (list 24.25 (- 43 ks1 (/ m 2)))
	   )
	 )
	 (if (and (> ks2 21) (< ks1 21))
	   (progn
	     (setq m (- 21 ks1))
	     (setq p1 (list 4.75 (- 22 ks1 (/ m 2)))
		   p2 (list 5.85 (- 22 ks1 (/ m 2)))
	     )
	     (setq m (- ks2 21))
	     (setq p3 (list 23.15 (- 22 (/ m 2)))
		   p4 (list 24.25 (- 22 (/ m 2)))
	     )
	     (command "_.text" "s" "style1" "m" p3 0.16 0 "(f)")
	     (command "_.text" "s" "style1" "m" p4 0.16 0 "(f)")
	   )				;endprogn
	 )				;endif
	 (command "_.text" "s" "style1" "m" p1 0.16 0 "(f)")
	 (command "_.text" "s" "style1" "m" p2 0.16 0 "(f)")
       )				;end progn1	
      )					;9

      ((or (= yx "根植土") (= yx "种植土"))
       (progn				;progn1
	 (setq fileyx (strcat "c:/Gees2000/岩土花纹/" yx))
	 (setq fileyx1 (strcat "c:/Gees2000/岩土花纹/" yx ".dwg"))
	 (if (findfile fileyx1)		;if1111111111111111111111111
	   (if (< (/ (- ks2 ks1) 1.3) 1) ;if1
	     (progn
	       (setq m (- ks2 ks1))
	       (if (< (+ ks1 (* m 0.5)) 21) ;if2
		 (setq p1 (list 4.75 (- 22 ks1 0.1))
		       p2 (list 5.85 (- 22 ks1 0.1))
		 )
		 (setq p1 (list 23.15 (- 43 ks1 0.1))
		       p2 (list 24.25 (- 43 ks1 0.1))
		 )
	       )			;end if2
	       (command "_.insert" "d:/1/根植土" p1 0.8 0.8 "")
	       (command "_.insert" "d:/1/根植土" p2 0.8 0.8 "")
	     )				;endprogn
	     (progn			;progn2
	       (setq i 0)
	       (setq m (/ (- ks2 ks1) (fix (/ (- ks2 ks1) 1.3))))
	       (repeat (fix (/ (- ks2 ks1) 1.3))
		 (setq i (1+ i))
		 (if (< (+ ks1 (* m i)) 21) ;if2
		   (setq p1 (list 4.75 (- 22 ks1 (* m i) (- (/ m 2))))
			 p2 (list 5.85 (- 22 ks1 (* m i) (- (/ m 2))))
		   )
		   (setq p1 (list 23.15 (- 43 ks1 (* m i) (- (/ m 2))))
			 p2 (list 24.25 (- 43 ks1 (* m i) (- (/ m 2))))
		   )
		 )			;end if2
		 (command "_.insert" "d:/1/根植土" p1 0.8 0.8 "")
		 (command "_.insert" "d:/1/根植土" p2 0.8 0.8 "")

	       )			;repeat
	     )				;endprogn2
	   )				;end if1
	 )				;endif111111111111111111111111
       )				;progn1
      )					;12
      (t (setq yx nil))
    )					;end cond '("全风化"	  "强风化"   "中风化"	"弱风化"   "微风化"  "粗砂"	  "中砂"     "细砂"	"粉砂"	   "晶屑"   "熔结" "根植土" "种植土")
					;end cond '("全风化"	  "强风化"   "中风化"	"弱风化"   "微风化"  "粗砂"	  "中砂"     "细砂"	"粉砂"	   "晶屑"   "熔结" "根植土" "种植土")
    (setq yx nil)
    (setq yx (apply 'qdyx (list '("晶屑") yxms)))
    (if	(= yx "晶屑")
      (progn				;progn1
	(if (< (/ (- ks2 ks1) 0.6) 1)	;if1
	  (progn
	    (setq m (- ks2 ks1))
	    (if	(< (+ ks1 (* m 0.5)) 21) ;if2
	      (setq p1 (list 4.75 (- 22 ks1 (/ m 2)))
		    p2 (list 5.85 (- 22 ks1 (/ m 2)))
	      )
	      (setq p1 (list 23.15 (- 43 ks1 (/ m 2)))
		    p2 (list 24.25 (- 43 ks1 (/ m 2)))
	      )
	    )				;end if2
	    (command "_.text" "s" "style1" "m" p1 0.16 0 "J")
	    (command "_.text" "s" "style1" "m" p2 0.16 0 "J")
	  )				;endprogn
	  (progn			;progn2
	    (setq i  0
		  PY 0.2
	    )
	    (setq m (/ (- ks2 ks1) (fix (/ (- ks2 ks1) 0.6))))
	    (repeat (fix (/ (- ks2 ks1) 0.6))
	      (setq i (1+ i))
	      (setq PY (- 0 PY))
	      (if (< (+ ks1 (* m i)) 21) ;if2
		(setq p1 (list (- 4.75 PY) (- 22 ks1 (* m i) (- (/ m 2))))
		      p2 (list (- 5.85 PY) (- 22 ks1 (* m i) (- (/ m 2))))
		)
		(setq p1 (list (- 23.15 PY) (- 43 ks1 (* m i) (- (/ m 2))))
		      p2 (list (- 24.25 PY) (- 43 ks1 (* m i) (- (/ m 2))))
		)
	      )				;end if2
	      (if (< (cadr p1) 22)
		(progn (command "_.text" "s" "style1" "m" p1 0.16 0 "J")
		       (command "_.text" "s" "style1" "m" p2 0.16 0 "J")
		)
	      )

	    )				;repeat
	  )				;endprogn2
	)				;end if1

      )					;progn1
    )					;end if "晶屑"
    (setq yx nil)
    (setq yx (apply 'qdyx (list '("熔结") yxms)))
    (if	(= yx "熔结")
      (progn				;progn1
	(if (< (/ (- ks2 ks1) 0.6) 1)	;if1
	  (progn
	    (setq m (- ks2 ks1))
	    (if	(< (+ ks1 (* m 0.5)) 21) ;if2
	      (setq p1 (list 4.5 (- 22 ks1 (/ m 2)))
		    p2 (list 5.6 (- 22 ks1 (/ m 2)))
	      )
	      (setq p1 (list 22.9 (- 43 ks1 (/ m 2)))
		    p2 (list 24 (- 43 ks1 (/ m 2)))
	      )
	    )				;end if2
	    (command "_.text" "s" "style1" "m" p1 0.16 0 "ω")
	    (command "_.text" "s" "style1" "m" p2 0.16 0 "ω")
	  )				;endprogn
	  (progn			;progn2
	    (setq i   0
		  PY  0.2
		  ant 0
	    )
	    (setq m (/ (- ks2 ks1) (fix (/ (- ks2 ks1) 0.6))))
	    (repeat (fix (/ (- ks2 ks1) 0.6))
	      (setq i (1+ i))
	      (setq PY	(- 0 PY)
		    ant	(+ ant 33)
	      )
	      (if (< (+ ks1 (* m i)) 21) ;if2
		(setq p1 (list (+ 4.75 PY) (- 22 ks1 (* m i) (- (/ m 2))))
		      p2 (list (+ 5.85 PY) (- 22 ks1 (* m i) (- (/ m 2))))
		)
		(setq p1 (list (+ 23.15 PY) (- 43 ks1 (* m i) (- (/ m 2))))
		      p2 (list (+ 24.25 PY) (- 43 ks1 (* m i) (- (/ m 2))))
		)
	      )				;end if2
	      (if (< (cadr p1) 22)
		(progn
		  (command "_.text" "s" "style1" "m" p1 0.16 ant "ω")
		  (command "_.text" "s" "style1" "m" p2 0.16 ant "ω")
		)
	      )

	    )				;repeat
	  )				;endprogn2
	)				;end if1

      )					;progn1
    )					;end if"熔结"

    (setq yx nil)
    (setq yx (apply 'qdyxm (list bzyxb3 yxms)))
    (setq myyx (apply 'tfmc(list yx)))
    (setq fileyx (strcat "c:/Gees2000/岩土花纹/" myyx))
    (setq fileyx1 (strcat "c:/Gees2000/岩土花纹/" myyx ".dwg"))
    (if	(findfile fileyx1)		;if1111111111111111111111111
      (progn				;progn111111111111
	(if (<= ks2 21)			;if101 101 101 101
	  (if (< (/ (- ks2 ks1) 0.45) 1.5) ;if1
	    (progn ;;progn1
		   (setq m (- ks2 ks1))
		   (setq p1 (list 4.525 (- 22 ks1 (/ m 2)))
			 p2 (list 5.625 (- 22 ks1 (/ m 2)))
		   )
		   (setq m2 (/ m 0.45))
		   (command "_.minsert" fileyx p1 1 m2 "" 1 2 0.45)
		   (command "_.minsert" fileyx p2 1 m2 "" 1 2 0.45)
	    )				;endprogn1
	    (progn			;progn2
	      (setq n (fix (/ (- ks2 ks1) 0.45)))
	      (if (= n 1)
		(setq n 2)
	      )
	      (setq m (/ (- ks2 ks1) n))
	      (setq p1 (list 4.525 (- 22 ks1 (/ m 2)))
		    p2 (list 5.625 (- 22 ks1 (/ m 2)))
	      )
	      (setq m1 (- 0 m))
	      (setq m2 (/ m 0.45))
	      (command "_.minsert" fileyx p1 1 m2 "" n 2 m1 0.45)
	      (command "_.minsert" fileyx p2 1 m2 "" n 2 m1 0.45)
	    )				;endprogn2
	  )				;end if1
	)				;end if101 101 101 101 101
	(if (>= ks1 21)			;if102 102 102 102 102 102
	  (if (< (/ (- ks2 ks1) 0.45) 1.5) ;if1
	    (progn ;;progn1
		   (setq m (- ks2 ks1))
		   (setq p1 (list 22.925 (- 43 ks1 (/ m 2)))
			 p2 (list 24.025 (- 43 ks1 (/ m 2)))
		   )
		   (setq m2 (/ m 0.45))
		   (command "_.minsert" fileyx p1 1 m2 "" 1 2 0.45)
		   (command "_.minsert" fileyx p2 1 m2 "" 1 2 0.45)
	    )				;endprogn1
	    (progn			;progn2
	      (setq n (fix (/ (- ks2 ks1) 0.45)))
	      (if (= n 1)
		(setq n 2)
	      )
	      (setq m (/ (- ks2 ks1) n))
	      (setq p1 (list 22.925 (- 43 ks1 (/ m 2)))
		    p2 (list 24.025 (- 43 ks1 (/ m 2)))
	      )
	      (setq m1 (- 0 m))
	      (setq m2 (/ m 0.45))
	      (command "_.minsert" fileyx p1 1 m2 "" n 2 m1 0.45)
	      (command "_.minsert" fileyx p2 1 m2 "" n 2 m1 0.45)
	    )				;endprogn2
	  )				;end if1
	)				;end if102  102 102 102 102
	(if (and (< ks1 21) (> ks2 21))	;if103 103 103 103)
	  (progn			;progn103 103 103 103
	    (if	(< (/ (- 21 ks1) 0.45) 1.5) ;if1
	      (progn ;;progn1
		     (setq m (- 21 ks1))
		     (setq p1 (list 4.525 (- 22 ks1 (/ m 2)))
			   p2 (list 5.625 (- 22 ks1 (/ m 2)))
		     )
		     (setq m2 (/ m 0.45))
		     (command "_.minsert" fileyx p1 1 m2 "" 1 2 0.45)
		     (command "_.minsert" fileyx p2 1 m2 "" 1 2 0.45)
	      )				;endprogn1
	      (progn			;progn2
		(setq n (fix (/ (- 21 ks1) 0.45)))
		(if (= n 1)
		  (setq n 2)
		)
		(setq m (/ (- 21 ks1) n))
		(setq p1 (list 4.525 (- 22 ks1 (/ m 2)))
		      p2 (list 5.625 (- 22 ks1 (/ m 2)))
		)
		(setq m1 (- 0 m))
		(setq m2 (/ m 0.45))
		(command "_.minsert" fileyx p1 1 m2 "" n 2 m1 0.45)
		(command "_.minsert" fileyx p2 1 m2 "" n 2 m1 0.45)
	      )				;endprogn2
	    )				;end if1
	    (if	(< (/ (- ks2 21) 0.45) 1.5) ;if2
	      (progn ;;progn1
		     (setq m (- ks2 21))
		     (setq p1 (list 22.925 (- 22 (/ m 2)))
			   p2 (list 24.025 (- 22 (/ m 2)))
		     )
		     (setq m2 (/ m 0.45))
		     (command "_.minsert" fileyx p1 1 m2 "" 1 2 0.45)
		     (command "_.minsert" fileyx p2 1 m2 "" 1 2 0.45)
	      )				;endprogn1
	      (progn			;progn2
		(setq n (fix (/ (- ks2 21) 0.45)))
		(if (= n 1)
		  (setq n 2)
		)
		(setq m (/ (- ks2 21) n))
		(setq p1 (list 22.925 (- 22 (/ m 2)))
		      p2 (list 24.025 (- 22 (/ m 2)))
		)
		(setq m1 (- 0 m))
		(setq m2 (/ m 0.45))
		(command "_.minsert" fileyx p1 1 m2 "" n 2 m1 0.45)
		(command "_.minsert" fileyx p2 1 m2 "" n 2 m1 0.45)
	      )				;endprogn2
	    )				;end if2
	  )				;endprogn103 103 103 103
	)				;end if103 03 103 103 103
      )					;endprogn111111111111111111
    )					;endif11111111111111111111111
  )					;end defun huawentc(bzyxb3 yxms ks1 ks2)00000000000000000000000000000000000000000000000000000000000000000000000000
					;end defun huawentc(bzyxb3 yxms ks1 ks2)00000000000000000000000000000000000000000000000000000000000000000000000000
					;end defun huawentc(bzyxb3 yxms ks1 ks2)00000000000000000000000000000000000000000000000000000000000000000000000000
					;end defun huawentc(bzyxb3 yxms ks1 ks2)00000000000000000000000000000000000000000000000000000000000000000000000000
					;end defun huawentc(bzyxb3 yxms ks1 ks2)00000000000000000000000000000000000000000000000000000000000000000000000000
					;end defun huawentc(bzyxb3 yxms ks1 ks2)00000000000000000000000000000000000000000000000000000000000000000000000000











;;;;;从柱状图综合数据表zk中读出综合表zhb、孔深表ksb、岩性描述表yxmsb
;;;;;状态密度表ztmdb、含水量表hslb、承载力表czlb、摩阻力表mzlb、取样表qyb
;;;;;原位测试表ywcsb 
  (setq zhb nil)
  (setq ksb nil)
  (setq yxmsb nil)
  (setq ztmdb nil)
  (setq hslb nil)
  (setq czlb nil)
  (setq mzlb nil)
  (setq yzyb nil)
  (setq ldyb nil)
  (setq yyb nil)
  (setq bgb nil)
  (setq zeb nil)
  (setq fchb nil)
  (setq cyfhb nil)
  (setq lsdtb nil)

  (setq i1 0)
  (if (= (nth i1 zk) "---0")
    (progn				;progn0
      (setq i1 (1+ i1))
      (while (/= (substr (nth i1 zk) 1 3) "---") ;while0
	(setq zhb (append zhb (list (nth i1 zk))))
	(setq i1 (1+ i1))
	(setq abc (nth i1 zk))
      )					;end while0
    )					;end progn0
  )					;end if---0
  (if (= (nth i1 zk) "---1")
    (progn				;progn0
      (setq i1 (1+ i1))
      (while (/= (substr (nth i1 zk) 1 3) "---") ;while0
	(setq ksb (append ksb (list (nth i1 zk))))
	(setq i1 (1+ i1))
	(setq abc (nth i1 zk))
      )					;end while0
    )					;end progn0
  )					;end if---1
  (if (= (nth i1 zk) "---2")
    (progn				;progn0
      (setq i1 (1+ i1))
      (while (/= (substr (nth i1 zk) 1 3) "---") ;while0
	(setq yxmsb (append yxmsb (list (nth i1 zk))))
	(setq i1 (1+ i1))
	(setq abc (nth i1 zk))
      )					;end while0
    )					;end progn0
  )					;end if---2
  (if (= (nth i1 zk) "---3")
    (progn				;progn0
      (setq i1 (1+ i1))
      (while (/= (substr (nth i1 zk) 1 3) "---") ;while0
	(setq fchb (append fchb (list (nth i1 zk))))
	(setq i1 (1+ i1))
	(setq abc (nth i1 zk))
      )					;end while0
    )					;end progn0
  )					;end if---2
  (if (= (nth i1 zk) "---4")
    (progn				;progn0
      (setq i1 (1+ i1))
      (while (/= (substr (nth i1 zk) 1 3) "---") ;while0
	(setq cyfhb (append cyfhb (list (nth i1 zk))))
	(setq i1 (1+ i1))
	(setq abc (nth i1 zk))
      )					;end while0
    )					;end progn0
  )					;end if---2

  (if (= (nth i1 zk) "---5")
    (progn				;progn0
      (setq i1 (1+ i1))
      (while (/= (substr (nth i1 zk) 1 3) "---") ;while0
	(setq ztmdb (append ztmdb (list (nth i1 zk))))
	(setq i1 (1+ i1))
	(setq abc (nth i1 zk))
      )					;end while0
    )					;end progn0
  )					;end if---3
  (if (= (nth i1 zk) "---6")
    (progn				;progn0
      (setq i1 (1+ i1))
      (while (/= (substr (nth i1 zk) 1 3) "---") ;while0
	(setq hslb (append hslb (list (nth i1 zk))))
	(setq i1 (1+ i1))
	(setq abc (nth i1 zk))
      )					;end while0
    )					;end progn0
  )					;end if---4
  (if (= (nth i1 zk) "---7")
    (progn				;progn0
      (setq i1 (1+ i1))
      (while (/= (substr (nth i1 zk) 1 3) "---") ;while0
	(setq czlb (append czlb (list (nth i1 zk))))
	(setq i1 (1+ i1))
	(setq abc (nth i1 zk))
      )					;end while0
    )					;end progn0
  )					;end if---5
  (if (= (nth i1 zk) "---8")
    (progn				;progn0
      (setq i1 (1+ i1))
      (while (/= (substr (nth i1 zk) 1 3) "---") ;while0
	(setq mzlb (append mzlb (list (nth i1 zk))))
	(setq i1 (1+ i1))
	(setq abc (nth i1 zk))
      )					;end while0
    )					;end progn0
  )					;end if---6
  (if (= (nth i1 zk) "---9")
    (progn				;progn0
      (setq i1 (1+ i1))
      (while (/= (substr (nth i1 zk) 1 3) "---") ;while0
	(setq yzyb (append yzyb (list (nth i1 zk))))
	(setq i1 (1+ i1))
	(setq abc (nth i1 zk))
      )					;end while0
    )					;end progn0
  )					;end if---7
  (if (= (nth i1 zk) "---10")
    (progn				;progn0
      (setq i1 (1+ i1))
      (while (/= (substr (nth i1 zk) 1 3) "---") ;while0
	(setq ldyb (append ldyb (list (nth i1 zk))))
	(setq i1 (1+ i1))
	(setq abc (nth i1 zk))
      )					;end while0
    )					;end progn0
  )					;end if---8
  (if (= (nth i1 zk) "---11")
    (progn				;progn0
      (setq i1 (1+ i1))
      (while (/= (substr (nth i1 zk) 1 3) "---") ;while0
	(setq bgb (append bgb (list (nth i1 zk))))
	(setq i1 (1+ i1))
	(setq abc (nth i1 zk))
      )					;end while0
    )					;end progn0
  )					;end if---9
  (if (= (nth i1 zk) "---12")
    (progn				;progn0
      (setq i1 (1+ i1))
      (while (/= (substr (nth i1 zk) 1 3) "---") ;while0
	(setq zeb (append zeb (list (nth i1 zk))))
	(setq i1 (1+ i1))
	(setq abc (nth i1 zk))
      )					;end while0
    )					;end progn0
  )					;end if---10



(if (= (nth i1 zk) "---13")
    (progn				;progn0
      (setq i1 (1+ i1))
      (while (/= (substr (nth i1 zk) 1 3) "---") ;while0
	(setq yyb (append yyb (list (nth i1 zk))))
	(setq i1 (1+ i1))
	(setq abc (nth i1 zk))
      )					;end while0
    )					;end progn0
  )

  (if (= (nth i1 zk) "---14")
    (progn				;progn0
      (setq i1 (1+ i1))
      (while (/= (substr (nth i1 zk) 1 3) "---") ;while0
	(setq lsdtb (append lsdtb (list (nth i1 zk))))
	(setq i1 (1+ i1))
	(setq abc (nth i1 zk))
      )					;end while0
    )					;end progn0
  )					;end if---10



  (if (= (nth i1 zk) "---15")
    (progn				;progn0
      (setq i1 (1+ i1))
      (setq dtblc (nth i1 zk))
    )					;end while0
  )					;end progn0

  
;;;;;;;;;draw zzt
;;;;;;;;;draw zzt
;;;;;;;;;draw zzt
;;;;;;;;;draw zzt
;;;;;;;;;draw zzt
;;;;;;;;;draw zzt
;;;;;;;;;draw zzt
;;;;;;;;;draw zzt
;;;;;;;;;draw zzt
;;;;;;;;;draw zzt
;;;;;;;;;draw zzt
;;;;;;;;;draw zzt
  (setq gcmc (nth 0 zhb))
  (if (< (strlen gcmc) 34)
  (command "_.text" "S"	"style1" "ml" "2.2488,25.78" 0.23 0 gcmc)
  (command "_.text" "s" "style1" "j" "f" "2.2488,25.65" "7.6273,25.65" 0.23 gcmc)
    )
  (setq kh1 (nth 1 zhb))
  (command "_.text" "S"	"style1" "ml" "2.2488,25.38" 0.23 0 kh1)
  (setq kg (nth 4 zhb))
  (if (= kg nil)
    (setq kg "0")
  )
  (command "_.text" "S"	"style1" "ml" "9.6303,25.38" 0.23 0 kg)
  (setq bl (nth 11 zhb))
  (if (or (= bl nil) (= (atof bl) 0))
    (setq bl "100")
  )
  (command "_.text" "S" "style1" "ml" "5.3,22.7" 0.23 0 bl)
  (setq x (nth 2 zhb))
  (command "_.text" "S" "style1" "ml" "2.6529,25.02" 0.18 0 x)
  (setq y (nth 3 zhb))
  (command "_.text" "S" "style1" "ml" "5.0516,25.02" 0.18 0 y)
  (setq kn (nth 5 zhb))
  (command "_.text" "S"	"style1" "ml" "13.7582,25.78" 0.23 0 kn)
  (setq Ky (nth 6 zhb))
  (command "_.text" "S"	"style1" "m" "14.9612,25.78" 0.23 0 ky)
  (setq kt (nth 7 zhb))
  (command "_.text" "S"	"style1" "m" "15.6207,25.78" 0.23 0 kt)
  (setq zn (nth 8 zhb))
  (command "_.text" "S"	"style1" "ml" "13.7582,25.38" 0.23 0 zn)
  (setq zy (nth 9 zhb))
  (command "_.text" "S"	"style1" "m" "14.9612,25.38" 0.23 0 zy)
  (setq zt (nth 10 zhb))
  (command "_.text" "S"	"style1" "m" "15.6207,25.38" 0.23 0 zt)
  (setq lczh (nth 14 zhb))
  (command "_.text" "S"	"style1" "ml" "9.6303,25.78" 0.23 0 lczh)
  (setq n 1)
  (repeat (- (length ksb) 1)		;repeat1
    (progn				;progn1
      (setq ks (atof (nth n ksb)))
      (setq cyks(/(+ ks(atof (nth (1- n) ksb)))2))
      (if (>= (- 22 (/ ks (/ (atof bl) 100))) 1) ;if2
	(progn				;progn3
	  (setq p0 (list 0.8 (- 22.3 (/ ks (/ (atof bl) 100)))))
	  (setq p1 (list 0.3 (- 22 (/ ks (/ (atof bl) 100)))))
	  (setq p2 (list 5.2 (- 22 (/ ks (/ (atof bl) 100)))))
	  (setq p3 (list 5.4 (- 22 (/ ks (/ (atof bl) 100)))))
	  (setq p4 (list 6.3 (- 22 (/ ks (/ (atof bl) 100)))))
	  (setq p5 (list 10.3 (- 22 (/ ks (/ (atof bl) 100)))))
	  (setq p6 (list 12.7 (- 22 (/ ks (/ (atof bl) 100)))))
	  (setq tp1 (list 1.8 (- 22 (/ ks (/ (atof bl) 100)) -0.13)))
	  (setq tp2 (list 2.8 (- 22 (/ ks (/ (atof bl) 100)) -0.13)))
	  (setq tp3 (list 3.8 (- 22 (/ ks (/ (atof bl) 100)) -0.13)))
	)				;end progn3
	(progn				;progn4
					;right
					;right
					;right
	  (if (< (strlen gcmc) 34)
	    (command "_.text"	"S"	   "style1"   "ml"
		     "22.2488,25.78"	   0.23	      0
		     gcmc
		    )
	    (command "_.text"	  "s"	       "style1"
		     "j"	  "f"	       "22.2488,25.65"
		     "28.1273,25.65"	       0.23
		     gcmc
		    )
	  )
	  (command "_.text"   "S"	 "style1"   "ml"
		   "20.6488,25.38"	 0.23	    0
		   kH1
		  )
	  (command "_.text"   "S"	 "style1"   "ml"
		   "28.8308,25.38"	 0.23	    0
		   kg
		  )
	  (command "_.text" "S" "style1" "ml" "23.7,22.7" 0.23 0 bl)
	  (command "_.text"   "S"	 "style1"   "ml"
		   "21.0529,25.02"	 0.18	    0
		   x
		  )
	  (command "_.text"   "S"	 "style1"   "ml"
		   "23.4516,25.02"	 0.18	    0
		   y
		  )
	  (command "_.text"   "S"	 "style1"   "ml"
		   "33.6582,25.78"	 0.23	    0
		   kn
		  )
	  (command "_.text"   "S"	 "style1"   "m"
		   "34.8612,25.78"	 0.23	    0
		   ky
		  )
	  (command "_.text"   "S"	 "style1"   "m"
		   "35.5207,25.78"	 0.23	    0
		   kt
		  )
	  (command "_.text"   "S"	 "style1"   "ml"
		   "33.6582,25.38"	 0.23	    0
		   zn
		  )
	  (command "_.text"   "S"	 "style1"   "m"
		   "34.8612,25.38"	 0.23	    0
		   zy
		  )
	  (command "_.text"   "S"	 "style1"   "m"
		   "35.5207,25.38"	 0.23	    0
		   zt
		  )
	  (command "_.text"    "S"	   "style1"    "ml"
		   "28.8303,25.78"	   0.23	       0
		   lczh
		  )
					;end right
					;end right    
	  (setq p0 (list 19.2 (- 43.3 (/ ks (/ (atof bl) 100)))))
	  (setq p1 (list 18.7 (- 43 (/ ks (/ (atof bl) 100)))))
	  (setq p2 (list 23.6 (- 43 (/ ks (/ (atof bl) 100)))))
	  (setq p3 (list 23.8 (- 43 (/ ks (/ (atof bl) 100)))))
	  (setq p4 (list 24.7 (- 43 (/ ks (/ (atof bl) 100)))))
	  (setq p5 (list 29.3 (- 43 (/ ks (/ (atof bl) 100)))))
	  (setq p6 (list 32.7 (- 43 (/ ks (/ (atof bl) 100)))))
	  (setq tp1 (list 20.2 (- 43 (/ ks (/ (atof bl) 100)) -0.13)))
	  (setq tp2 (list 21.2 (- 43 (/ ks (/ (atof bl) 100)) -0.13)))
	  (setq tp3 (list 22.2 (- 43 (/ ks (/ (atof bl) 100)) -0.13)))
	)				;end progn4
      )					;end if2
      (command "_.pline" p1 "w" 0.013 "" p2 "")
      (command "_.pline" p3 "w" 0.013 "" p4 "")
      (command "_.pline" p5 "w" 0.013 "" p6 "")
					;write number
      (setq txt2p (- ks (atof (nth (- n 1) ksb))))
      (setq txt1 (rtos ks 2 2))
      (setq txt2 (rtos txt2p 2 2))
      (setq txt3 (rtos (- (atof kg) ks) 2 2))
      (command "_.text" "s" "style1" "j" "m" tp1 0.2 0 txt1)
      (command "_.text" "s" "style1" "j" "m" tp2 0.2 0 txt2)
      (command "_.text" "s" "style1" "j" "m" tp3 0.2 0 txt3)
					;write number
       (if (>= (- 22 (/ cyks (/ (atof bl) 100))) 1) ;if2
	  (setq pbm (list 0.8 (- 22 (/ cyks (/ (atof bl) 100)))))
	  (setq pbm (list 19.2 (- 43 (/ cyks (/ (atof bl) 100)))))
	)

      (if (= (nth 6 gcwzb) "1")
	(progn
	  (setq	bm (strcat "c:/Gees2000/岩土花纹/"
			   (nth (1- n) cyfhb)
			   ".dwg"
		   )
	  )
	  (if (/= (findfile bm) nil)
	    (command "_.insert" bm pbm "" "" "")
	  )
	  ;;end if
	)
;;;endprogn
      )
;;;endif
      (setq n (+ 1 n))
    )					;progn1
  )					;end repeat
					;开始输入状态密度
					;开始输入状态密度
					;开始输入状态密度


  (setq i 0)
  (repeat (- (length ksb) 1)
					;repeat2-1
    (setq md (nth i ztmdb))
    (setq mdi 0 mdj 0 md1 "")
    (repeat(strlen md)
      (setq mdi (1+ mdi))
      (if(= (substr md mdi 1) "-")
	(setq mdj mdi)
	)
      );;;endrepeat
     (if (and(> mdj 1)(< mdj (strlen md)))
       (setq md1 (substr md 1 (1- mdj))md(substr md (1+ mdj)(- (strlen md)mdj)))
	     )
      
    (setq i (1+ i))
    (setq ks (atof (nth i ksb)))
    (if	(>= (- 22 (/ ks (/ (atof bl) 100))) 1)
      (setq tp1 (list 10.65 (- 22 (/ ks (/ (atof bl) 100)) -0.15)))
      (setq tp1 (list 29.65 (- 43 (/ ks (/ (atof bl) 100)) -0.15)))
    )					;end if2-2
    (command "_.text" "s" "style1" "j" "m" tp1 0.20 0 md)
    (if (/= md1 "")
      (progn
	(setq tp1 (list (car tp1)(+(cadr tp1)0.23)))
	(command "_.text" "s" "style1" "j" "m" tp1 0.20 0 "|")
	(setq tp1 (list (car tp1)(+(cadr tp1)0.23)))
	(command "_.text" "s" "style1" "j" "m" tp1 0.20 0 md1)
	);;;endprogn
      );;;;endif
  )					;end repeat2-1
					;结束输入状态密度
					;结束输入状态密度md
					;结束输入状态密度md
					;结束输入状态密度md


					;开始输入含水量sl
					;开始输入含水量sl
					;开始输入含水量sl
  (setq i 0)
  (repeat (- (length ksb) 1)
					;repeat 2-1
    (setq sl (nth i hslb))
    (setq sli 0 slj 0 sl1 "")
    (repeat(strlen sl)
      (setq sli (1+ sli))
      (if(= (substr sl sli 1) "-")
	(setq slj sli)
	)
      );;;endrepeat
     (if (and(> slj 1)(< slj (strlen sl)))
       (setq sl1 (substr sl 1 (1- slj))sl(substr sl (1+ slj)(- (strlen sl)slj)))
	     )
    (setq i (1+ i))
    (setq ks (atof (nth i ksb)))
    (if	(> (- 0 (/ ks (/ (atof bl) 100))) -21.00)
      (setq tp1 (list 11.35 (- 22 (/ ks (/ (atof bl) 100)) -0.15)))
      (setq tp1 (list 30.35 (- 43 (/ ks (/ (atof bl) 100)) -0.15)))
    )					;end if2-2
    (command "_.text" "s" "style1" "j" "m" tp1 0.20 0 sl)
    (if (/= sl1 "")
      (progn
	(setq tp1 (list (car tp1)(+(cadr tp1)0.23)))
	(command "_.text" "s" "style1" "j" "m" tp1 0.20 0 "|")
	(setq tp1 (list (car tp1)(+(cadr tp1)0.23)))
	(command "_.text" "s" "style1" "j" "m" tp1 0.20 0 sl1)
	);;;endprogn
      )
  )					;end repeat2-1
					;结束输入含水量
					;结束输入含水量
					;结束输入含水量
					;结束输入含水量


					;开始输入承载力及摩阻力cz mz
					;开始输入承载力及摩阻力cz mz
					;开始输入承载力及摩阻力cz mz
  (setq i 0)
  (repeat (- (length ksb) 1)
					;repaet2-1
    (setq cz (nth i czlb))
    (setq mz (nth i mzlb))
    (setq i (1+ i))
    (setq ks (atof (nth i ksb)))
    (if	(>= (- 22 (/ ks (/ (atof bl) 100))) 1)
      (progn				;progn2-2
	(setq
	  tp1 (list 12.2 (- 22 (/ ks (/ (atof bl) 100)) -0.13))
	)
	(setq
	  tp2 (list 13.2 (- 22 (/ ks (/ (atof bl) 100)) -0.13))
	)
      )					;end progn2
      (progn				;progn2-2
	(setq
	  tp1 (list 31.2 (- 43 (/ ks (/ (atof bl) 100)) -0.13))
	)
	(setq
	  tp2 (list 32.2 (- 43 (/ ks (/ (atof bl) 100)) -0.13))
	)
      )					;end progn2 
    )					;end if2-2
    (command "_.text" "s" "style1" "j" "m" tp1 0.20 0 cz)
    (command "_.text" "s" "style1" "j" "m" tp2 0.20 0 mz)
  )					;endrepeat2-1
					;结束输入承载力及摩阻力
					;结束输入承载力及摩阻力
					;结束输入承载力及摩阻力
					;结束输入承载力及摩阻力


					;开始输入地下水位sw
					;开始输入地下水位sw
					;开始输入地下水位sw

  
(if (= (nth 5 gcwzb) "1")
    (progn

      (setq swp nil)
      (setq swp (nth 12 zhb))
      (if (and (/= swp "") (/= swp "干") (/= swp "干孔"))
	(progn
	  (setq sw (atof swp))
	  (setq swkg (atof (nth 4 zhb)))
	  (setq swstring (rtos sw 2 2))
	  (setq swbg (rtos (- swkg sw) 2 2))
	  (if (>= (- 22 (/ sw (/ (atof bl) 100))) 1) ;if5-1
	    (setq psw (list 5.3 (- 22 (/ sw (/ (atof bl) 100)))))
	    (setq psw (list 33.2 (- 43 (/ sw (/ (atof bl) 100)))))
	  )				;end if5-1
	  (setq psw1 (list (- (car psw) 0.1) (cadr psw)))
	  (setq psw2 (list (+ (car psw) 0.1) (cadr psw)))
	  (command "_.line" psw1 psw2 "")
	  (setq psw1 (list (- (car psw) 0.07) (- (cadr psw) 0.1)))
	  (setq psw2 (list (+ (car psw) 0.07) (- (cadr psw) 0.1)))
	  (command "_.line" psw1 psw2 "")
	  (setq psw1 (list (- (car psw) 0.04) (- (cadr psw) 0.2)))
	  (setq psw2 (list (+ (car psw) 0.04) (- (cadr psw) 0.2)))
	  (command "_.line" psw1 psw2 "")
	  (setq psw1 (list (- (car psw) 0.09) (+ (cadr psw) 0.2)))
	  (setq psw2 (list (+ (car psw) 0.09) (+ (cadr psw) 0.2)))
	  (command "_.line" psw psw1 psw2 psw "")
	  (setq psw1 (list (car psw) (+ (cadr psw) 0.43)))
	  
	  (setq psw1 (list (car psw) (- (cadr psw) 0.43)))
	  
	)				;end progn
	
      )					;end if

    )
;;;end progn
  )


  (if (= (nth 5 gcwzb) "1")
    (progn

      (setq swp nil)
      (setq swp (nth 12 zhb))
      (if (and (/= swp "") (/= swp "干") (/= swp "干孔"))
	(progn
	  (setq sw (atof swp))
	  (setq swkg (atof (nth 4 zhb)))
	  (setq swstring (rtos sw 2 2))
	  (setq swbg (rtos (- swkg sw) 2 2))
	  (if (>= (- 22 (/ sw (/ (atof bl) 100))) 1) ;if5-1
	    (setq psw (list 14.8 (- 22 (/ sw (/ (atof bl) 100)))))
	    (setq psw (list 33.2 (- 43 (/ sw (/ (atof bl) 100)))))
	  )				;end if5-1
	  (setq psw1 (list (- (car psw) 0.4) (cadr psw)))
	  (setq psw2 (list (+ (car psw) 0.4) (cadr psw)))
	  (setq psw1 (list (- (car psw) 0.25) (- (cadr psw) 0.15)))
	  (setq psw2 (list (+ (car psw) 0.25) (- (cadr psw) 0.15)))
	  (setq psw1 (list (- (car psw) 0.1) (- (cadr psw) 0.3)))
	  (setq psw2 (list (+ (car psw) 0.1) (- (cadr psw) 0.3)))
	  (setq psw1 (list (- (car psw) 0.15) (+ (cadr psw) 0.3)))
	  (setq psw2 (list (+ (car psw) 0.15) (+ (cadr psw) 0.3)))
	  (setq psw1 (list (car psw) (+ (cadr psw) 0.43)))
	  (setq psw1 (list 7.52 25.02))
	  (command "_.text" "s" "style1" "j" "ml" psw1 0.23 0 "水位埋深(m):")
	  (setq psw1 (list 9.65 25.02))
	  (command "_.text" "s" "style1" "j" "ml" psw1 0.23 0 swstring)
	  (setq psw1 (list (car psw) (- (cadr psw) 0.43)))
	)				;end progn
	(progn
	  (setq psw1 (list 7.52 25.02))
	  (command "_.text" "s" "style1" "j" "ml" psw1 0.23 0 "水位埋深(m):")
	  (setq psw1 (list 9.65 25.02))
	  (command "_.text" "s" "style1" "j" "ml" psw1 0.23 0 "干孔")
	)
      )					;end if

    )
;;;end progn
  )
;;;end if;结束输入地下水位ytl

  
;;;end if;结束输入地下水位
					;结束输入地下水位
					;结束输入地下水位

					;开始输入岩性描述
					;开始输入岩性描述
					;开始输入岩性描述
					;开始输入岩性描述
					;第一层岩性描述p1和p2岩性描述底线的左右两个角点



;;;;;;;;YTCMSA4


(defun ytcms ()				;tp1为岩性描述mtext的起点,e为mtext文字块的垂直高度，tp1的xy座标以p2向右、向下各0.1cm
  (setq i9 0)
  (setq yxms (nth 0 yxmsb))
  (setq tp1 '(6.4 21.9))
  (command "_.mtext" tp1 "s" "style1" "j" "tl" "h" 0.23	"w" 3.9	yxms "")
  (setq eee (entget (entlast)))
  (setq ee (assoc '43 eee))
  (setq e (cdr ee))
  (setq ks1 (atof (nth i9 ksb)))
  (setq ks2 (atof (nth (1+ i9) ksb)))
  (setq p1 (list 6.3 (- 22 (/ ks2 (/ (atof bl) 100)))))
  (setq p4 (list 10.3 (- 22 (/ ks2 (/ (atof bl) 100)))))
  (if (<= e (/ (- ks2 ks1) (/ (atof bl) 100)))
					;if1
    (setq p2 (list 6.4 (cadr p1))
	  p3 (list 10.2 (cadr p4))
    )
    (setq p2 (list 6.4 (- 22 (/ ks1 (/ (atof bl) 100)) e 0.2))
	  p3 (list 10.2 (- 22 (/ ks1 (/ (atof bl) 100)) e 0.2))
    )
  )					;endif1
  (command "_.pline" p1 "w" 0.013 "" p2 p3 p4 "")
;;;;;;输入其它各层的岩性描述
  (repeat (- (length ksb) 2)
					;repeat 2-1
    (setq i9 (1+ i9))
    (setq ks1 (atof (nth i9 ksb)))
    (setq yxms (nth i9 yxmsb))
    (setq ks2 (atof (nth (1+ i9) ksb)))
    (if	(< (car p2) 18.3)
      (setq tp1 (list 6.4 (- (cadr p2) 0.1)))
      (setq tp1 (list 24.8 (- (cadr p2) 0.1)))
    )
    (command "_.mtext" tp1 "s" "style1"	"j" "tl" "h" 0.23 "w" 3.9 yxms
	     "")
    (setq eee (entget (entlast)))
    (setq ee (assoc '43 eee))
    (setq e (cdr ee))
    (setq pp2 p2)
;;;;第一个if为层底线及岩性描述均在左侧内 
    (if	(and (>= (- (cadr pp2) e) 1)
	     (<= (/ ks2 (/ (atof bl) 100)) 21)
	)
					;if1-1
;;;;这个progn为第一个if的then语句块 无else 语句  
      (progn				;progn1-1
	(setq p1 (list 6.3 (- 22 (/ ks2 (/ (atof bl) 100))))
	      p4 (list 10.3 (- 22 (/ ks2 (/ (atof bl) 100))))
	)
	(if (<= (- 22 (/ ks2 (/ (atof bl) 100))) (- (cadr p2) e 0.2))
					;if1-1-1
	  (setq	p2 (list 6.4 (cadr p1))
		p3 (list 10.2 (cadr p4))
	  )
	  (setq	p2 (list 6.4 (- (cadr pp2) e 0.2))
		p3 (list 10.2 (- (cadr pp2) e 0.2))
	  )
	)				;end if1-1-1
      )					;end progn1-1
    )					;end if1-1
;;;第二个if为岩性层底在左侧，岩性描述文字块的起点在左侧，而垂直终点在右侧
    (if	(and (< (- (cadr pp2) e) 1)
	     (<= (/ ks2 (/ (atof bl) 100)) 21)
	)				;if 1-2
;;;这个progn块为第二个if的then语句块，无else语句
      (progn
	(setq p1 '(24.7 22)
	      p4 '(29.3 22)
	)
	(setq h (- (cadr pp2) 1))
	(setq lh1 (* 26 (fix (/ h 0.4))))
	(progn (command "_.erase" (entlast) "")
	       (setq i lh1
		     j 2
		     loop t
	       )
	       (while loop
		 (setq i (1- i)
		       j (+ 2 j)
		 )
		 (setq k j)
		 (while (/= k 0)
				(setq k (1- k))
				(setq b (substr yxms (+ i k) 2))

				(if(>(+ i k)1)
				  (setq by (substr yxms (1-(+ i k)) 2))
				  )
				(if (or (= b "，") (= b "。"))
				  (setq	lh   (+ i k)
					loop nil
					k    0
				  )
				)
				(if (or (= by "，") (= by "。"))
				  (setq	lh   (1-(+ i k))
					loop nil
					k    0
				  )
				)

				(if (= (+ i k)1)
				  (setq	lh   -1
					loop nil
					k    0
				  )
				)
				
			      )			;end while
	       )			;end while
	       (setq yxms1 (substr yxms 1 (1+ lh)))
	       (setq yxms2 (substr yxms (+ 2 lh)))
	       (command	"_.mtext"	tp1	"s"	"style1"
			"j"	"tl"	"h"	0.23	"w"	3.9
			yxms1	""
		       )
	       (command	"_.mtext"	  "24.8,21.9"	    "s"
			"style1" "j"	  "tl"	   "h"	    0.23
			"w"	 3.9	  yxms2	   ""
		       )
	       (setq eee (entget (entlast)))
	       (setq ee (assoc '43 eee))
	       (setq e (cdr ee))
	       (if (< (- (/ ks2 (/ (atof bl) 100)) 21) e)
		 (setq p2 (list 24.8 (- 22 e 0.2))
		       p3 (list 29.2 (- 22 e 0.2))
		 )
	       )			;endif
	)				;progn


      )					;endprogn
    )					;end if 1-2


;;;第三个if ，为岩性层底线在右侧，分两种情况：一、岩性层顶线也在右侧；二、岩性层顶线在左侧

    (if	(>= (/ ks2 (/ (atof bl) 100)) 21)
					;if1-3
      ;;这个progn为第三个if的then语句块，无else 语句   
      (progn				;progn1-1
	(setq p1 (list 24.7 (- 43 (/ ks2 (/ (atof bl) 100))))
	      p4 (list 29.3 (- 43 (/ ks2 (/ (atof bl) 100))))
	)
	;;一、岩性层顶线也在右侧的情况，这个 if这第三个if的第一个嵌套if     
	(if (>= (/ ks1 (/ (atof bl) 100)) 21)
					;if1-3-1
;;;ks1>21
	  (if
	    (<= (- 43 (/ ks2 (/ (atof bl) 100))) (- (cadr pp2) e 0.2))
					;if1-3-1-1
	     (setq p2 (list 24.8 (cadr p1))
		   p3 (list 29.2 (cadr p4))
	     )
	     (setq p2 (list 24.8 (- (cadr pp2) e 0.2))
		   p3 (list 29.2 (- (cadr pp2) e 0.2))
	     )
	  )				;end if1-3-1-1

;;;;二、岩性层顶线在左侧的情况（底线在右侧），分两种情况
;;;;1、岩性描述文字块起点在左侧。2、岩性描述起点在右侧。
;;;;ks1<21
	  (if (< (car pp2) 18.3)
					;下一个if条件表明岩性层顶线在左侧的1、岩性描述文字块起点在左侧。即上个if的then语句块
					;又分为两种情况:a、岩性描述终点在右侧	b、岩性描述终点也在左侧。
	    (if
	      (<= (- 22 (/ ks2 (/ (atof bl) 100))) (- (cadr pp2) e 0.2))
					;if ksb<21
	       (progn			;prognif1-3-2-1
		 (setq p2 (list 24.8 (cadr p1))
		       p3 (list 29.2 (cadr p4))
		 )
		 (setq h (- (cadr pp2) 1))
		 (setq lh1 (* 26 (fix (/ h 0.4))))
		 (if (> (strlen yxms) lh1)
		   ;;ifif
;;;;这个if分为两种then语句块为a情况，其else语句块为b情况
		   (progn		;为then语句块为a情况
		     (command "_.erase" (entlast) "")
		     (setq i lh1
			   j 2
			   loop	t
		     )
		     (while loop
		       (setq i (1- i)
			     j (+ 2 j)
		       )
		       (setq k j)
		       (while (/= k 0)
				(setq k (1- k))
				(setq b (substr yxms (+ i k) 2))

				(if(>(+ i k)1)
				  (setq by (substr yxms (1-(+ i k)) 2))
				  )
				(if (or (= b "，") (= b "。"))
				  (setq	lh   (+ i k)
					loop nil
					k    0
				  )
				)
				(if (or (= by "，") (= by "。"))
				  (setq	lh   (1-(+ i k))
					loop nil
					k    0
				  )
				)

				(if (= (+ i k)1)
				  (setq	lh   -1
					loop nil
					k    0
				  )
				)
				
			      )		;end while
		     )			;end while
		     (setq yxms1 (substr yxms 1 (1+ lh)))
		     (setq yxms2 (substr yxms (+ 2 lh)))
		     (command "_.mtext"	      tp1     "s"     "style1"
			      "j"     "tl"    "h"     0.23    "w"
			      3.9     yxms1   ""
			     )
		     (command "_.mtext"		"24.8,21.9"
			      "s"      "style1"	"j"	 "tl"
			      "h"      0.23	"w"	 3.9
			      yxms2    ""
			     )
		     (setq eee (entget (entlast)))
		     (setq ee (assoc '43 eee))
		     (setq e (cdr ee))
		     (if (< (- (/ ks2 (/ (atof bl) 100)) 21) e)
		       (setq p2	(list 24.8 (- 22 e 0.2))
			     p3	(list 29.2 (- 22 e 0.2))
		       )
		     )			;endif
		   )			;progn
		 )
		 ;;ifif
	       )			;endprognif1-3-2-1
	       (progn			;b、岩性描述终点也在左侧。

		 (setq p2 (list 24.8 (+ 21 (- (cadr pp2) e 0.2)))
		       p3 (list 29.2 (+ 21 (- (cadr pp2) e 0.2)))
		 )

		 (setq h (- (cadr pp2) 1))
		 (setq lh1 (* 26 (fix (/ h 0.4))))
		 (if (> (strlen yxms) lh1)
		   ;;ifif
		   (progn (command "_.erase" (entlast) "")
			  (setq	i lh1
				j 2
				loop t
			  )
			  (while loop
			    (setq i (1- i)
				  j (+ 2 j)
			    )
			    (setq k j)
			    (while (/= k 0)
				(setq k (1- k))
				(setq b (substr yxms (+ i k) 2))

				(if(>(+ i k)1)
				  (setq by (substr yxms (1-(+ i k)) 2))
				  )
				(if (or (= b "，") (= b "。"))
				  (setq	lh   (+ i k)
					loop nil
					k    0
				  )
				)
				(if (or (= by "，") (= by "。"))
				  (setq	lh   (1-(+ i k))
					loop nil
					k    0
				  )
				)

				(if (= (+ i k)1)
				  (setq	lh   -1
					loop nil
					k    0
				  )
				)
				
			      )		;end while
			  )		;end while
			  (setq yxms1 (substr yxms 1 (1+ lh)))
			  (setq yxms2 (substr yxms (+ 2 lh)))
			  (command "_.mtext"	   tp1	   "s"
				   "style1"	   "j"	   "tl"
				   "h"	   0.23	   "w"	   3.9
				   yxms1   ""
				  )
			  (command "_.mtext"	     "24.8,21.9"
				   "s"	    "style1" "j"      "tl"
				   "h"	    0.23     "w"      3.9
				   yxms2    ""
				  )
			  (setq eee (entget (entlast)))
			  (setq ee (assoc '43 eee))
			  (setq e (cdr ee))
			  (if (< (- (/ ks2 (/ (atof bl) 100)) 21) e)
			    (setq p2 (list 24.8 (- 22 e 0.2))
				  p3 (list 29.2 (- 22 e 0.2))
			    )
			  )		;endif

		   )
		 )
		 ;;ifif

	       )			;endprognif1-3-2-2
	    )				;end if ksb<21
	    (progn			;else if (<(car pp2) 18.3)
					;这个progn为二、岩性层顶线在左侧的情况（底线在右侧），2、岩性描述起点在右侧。为else语句块
	      (if (<= (- 43 (/ ks2 (/ (atof bl) 100)))
		      (- (cadr pp2) e 0.2)
		  )
					;if1-3-1-1
		(setq p2 (list 24.8 (cadr p1))
		      p3 (list 29.2 (cadr p4))
		)
		(setq p2 (list 24.8 (- (cadr pp2) e 0.2))
		      p3 (list 29.2 (- (cadr pp2) e 0.2))
		)
	      )				;end if1-3-1-1

	    )				;endprognelse if (<(car pp2) 18.3)
	  )				;end if (<(car pp2) 18.3)
	)				;end if1-3-1
      )					;end progn1-1
    )					;end if1-3
    (command "_.pline" p1 "w" 0.013 "" p2 p3 p4 "")
  )					;end repeat2-1
					;结束输入含水量
)


;;;;;;;YTCMSA4  



  

					;p2和p3为岩性描述底线的中间下垂部份的左右两个角点
;;;;;;end defun

(apply 'ytcms())





  


;;;;;;以下部份为岩土花纹自动填充
;;;;;;以下部份为岩土花纹自动填充
;;;;;;以下部份为岩土花纹自动填充
;;;;;;以下部份为岩土花纹自动填充
;;;;;;以下部份为岩土花纹自动填充
;;;;;;以下部份为岩土花纹自动填充
;;;;;;以下部份为岩土花纹自动填充
;;;;;;以下部份为岩土花纹自动填充
;;;;;;以下部份为岩土花纹自动填充
;;;;;;以下部份为岩土花纹自动填充
;;;;;;以下部份为岩土花纹自动填充
;;;;;;以下部份为岩土花纹自动填充
;;;;;;以下部份为岩土花纹自动填充
;;;;;;以下部份为岩土花纹自动填充
;;;;;;以下部份为岩土花纹自动填充


  (setq i11 0)
  (repeat (1- (length ksb))		;repeat00000000000000000000000000000000000000000000
    (setq ks1p (atof (nth i11 ksb)))
    (setq ks1 (/ ks1p (/ (atof bl) 100)))
    (setq yxms (nth i11 yxmsb))
    (setq i11 (1+ i11))
    (setq ks2p (atof (nth i11 ksb)))
    (setq ks2 (/ ks2p (/ (atof bl) 100)))
    (apply 'huawentc (list bzyxb yxms ks1 ks2))
  )					;end repeat0000000000000000000000000000000000000000000000000



;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;
  (setq	i  0
	ch (/ (length yzyb) 3)
  )
  (repeat ch				;repeat 00000000000000000000000000000
    (setq a (nth i yzyb)
	  b (nth (1+ i) yzyb)
	  c (nth (+ i 2) yzyb)
    )
    (setq i (+ i 3))
    (if	(and (/= b "") (/= c ""))
      (setq d (/ (+ (atof b) (atof c)) 2 (/ (atof bl) 100)))
      (setq d (/ (+ (atof b) (atof c)) (/ (atof bl) 100)))
    )					;end if
    (setq e (strcat b "～" c))
    (if	(< d 21)
      (setq p1	(list 4.9 (- 22 d))
	    p2	(list 13.8 (- 22 d))
	    p3	(list 15.1 (- 22 d))
	    tp1	(list 14.45 (- 22.15 d))
	    tp2	(list 14.45 (- 21.88 d))
      )
      (setq p1	(list 23.3 (- 43 d))
	    p2	(list 33.8 (- 43 d))
	    p3	(list 35.1 (- 43 d))
	    tp1	(list 34.45 (- 43.2 d))
	    tp2	(list 34.45 (- 42.8 d))
      )
    )					;endif
    (command "_.pline" p2 "w" 0.013 "" p3 "")
    (command "_.text" "s" "style1" "m" tp1 0.21 0 a)
    (command "_.text" "s" "style1" "m" tp2 0.18 0 e)
    (if	(= (nth 1 gcwzb) "1")
      (if (findfile "c:/gees2000/岩土花纹/原状样.dwg")
	(command "_.insert"	      "c:/gees2000/岩土花纹/原状样.dwg"
		 p1		      1
		 1		      ""
		)
      )
    )
;;;end if  
    (command)
  )					;end repeat000000000000000000000000000000000000000000


  (setq	i  0
	ch (/ (length ldyb) 3)
  )
  (repeat ch				;repeat 00000000000000000000000000000
    (setq a (nth i ldyb)
	  b (nth (1+ i) ldyb)
	  c (nth (+ i 2) ldyb)
    )
    (setq i (+ i 3))
    (if	(and (/= b "") (/= c ""))
      (setq d (/ (+ (atof b) (atof c)) 2 (/ (atof bl) 100)))
      (setq d (/ (+ (atof b) (atof c)) (/ (atof bl) 100)))
    )					;end if
    (setq e (strcat b "～" c))
    (if	(< d 21)
      (setq p1	(list 4.9 (- 22 d))
	    p2	(list 13.8 (- 22 d))
	    p3	(list 15.1 (- 22 d))
	    tp1	(list 14.45 (- 22.15 d))
	    tp2	(list 14.45 (- 21.88 d))
      )
      (setq p1	(list 23.3 (- 43 d))
	    p2	(list 33.8 (- 43 d))
	    p3	(list 35.1 (- 43 d))
	    tp1	(list 34.45 (- 43.2 d))
	    tp2	(list 34.45 (- 42.8 d))
      )
    )					;endif
    (command "_.pline" p2 "w" 0.013 "" p3 "")
    (command "_.text" "s" "style1" "m" tp1 0.21 0 a)
    (command "_.text" "s" "style1" "m" tp2 0.18 0 e)
    (if	(= (nth 2 gcwzb) "1")
      (if (findfile "c:/gees2000/岩土花纹/扰动样.dwg")
	(command "_.insert"	      "c:/gees2000/岩土花纹/扰动样.dwg"
		 p1		      1
		 1		      ""
		)
      )
    )
;;;endif
    (command)
  )					;end repeat000000000000000000000000000000000000000000



(setq	i  0
	ch (/ (length yyb) 3)
  )
  (repeat ch				;repeat 00000000000000000000000000000
    (setq a (nth i yyb)
	  b (nth (1+ i) yyb)
	  c (nth (+ i 2) yyb)
    )
    (setq i (+ i 3))
    (if	(and (/= b "") (/= c ""))
      (setq d (/ (+ (atof b) (atof c)) 2 (/ (atof bl) 100)))
      (setq d (/ (+ (atof b) (atof c)) (/ (atof bl) 100)))
    )					;end if
    (setq e (strcat b "～" c))
    (if	(< d 21)
      (setq p1	(list 4.9 (- 22 d))
	    p2	(list 15.4 (- 22 d))
	    p3	(list 16.7 (- 22 d))
	    tp1	(list 16.05 (- 22.15 d))
	    tp2	(list 16.05 (- 21.88 d))
      )
      (setq p1	(list 23.3 (- 43 d))
	    p2	(list 33.8 (- 43 d))
	    p3	(list 35.1 (- 43 d))
	    tp1	(list 34.45 (- 43.2 d))
	    tp2	(list 34.45 (- 42.8 d))
      )
    )					;endif
    (command "_.pline" p2 "w" 0.013 "" p3 "")
    (command "_.text" "s" "style1" "m" tp1 0.21 0 a)
    (command "_.text" "s" "style1" "m" tp2 0.18 0 e)
    (if	(= (nth 2 gcwzb) "1")
      (if (findfile "c:/gees2000/岩土花纹/岩样.dwg")
	(command "_.insert"	     "c:/gees2000/岩土花纹/岩样.dwg"
		 p1		     1
		 1		     ""
		)
      )
    )
;;;endif
    (command)
  )					;end repeat000000000000000000000000000000000000000000



  

  (setq	i  0
	ch (/ (length bgb) 5)
  )
  					;end repeat000000000000000000000000000000000000000000




  (setq	i  0
	ch (/ (length zeb) 5)
  )
  					;end repeat000000000000000000000000000000000000000000

;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;


)					;enddefun zzt1fun(zk bzyxb)*******************************************************************************************************

					;enddefun zzt1fun(zk bzyxb)*******************************************************************************************************
					;enddefun zzt1fun(zk bzyxb)*******************************************************************************************************

					;enddefun zzt1fun(zk bzyxb)*******************************************************************************************************

					;enddefun zzt1fun(zk bzyxb)*******************************************************************************************************



(setq filename0 "c:/Gees2000/标准岩土名称.txt")
(setq bzyxb (apply 'getbzyxb (list filename0)))

(setq
  filename1 (nth 0 (apply 'readfile1 (list "c:/Gees2000/gcwz.txt")))
)
(setq listname1 "**zzt")
(setq zzt (apply 'readfile (list filename1 listname1)))



(setq
  filename3 (nth 0 (apply 'readfile1 (list "c:/Gees2000/gcwz.txt")))
)



(defun previewzzt ()
  (setq l00 (length zzt))
(setq pmh 10000)



(setq i	0
      j	0
)
(while (< i (length zzt))
  (if (= (nth i zzt) "---zzt")
    (setq j (1+ j))
  )
  (setq i (1+ i))
)					;end whille
(setq zym (1- j))









  (setq	i 0
	j 0
  )
  (while (and (< j zzth) (< i (length zzt)))
    (setq i00 i)
    (if	(= (nth i zzt) "---zzt")
      (setq j (1+ j))
    )
    (setq i (1+ i))
  )					;end whille


  (if (< i00 (1- l00))
;;;if0000000000000000000000000000000000000
    (progn
;;;progn000000000000000000000000000000000000000000000

      (setq d (nth i00 zzt))
      (if (= (nth i00 zzt) "---zzt")
	(setq j00 t
	      a	nil
	      b	nil
	)
      )
      (setq i00 (1+ i00))
      (setq zkmc1 "" zkmc2 "")
      (setq d (nth i00 zzt))
      (while (and (/= (nth i00 zzt) "---zzt") (< i00 l00))
					;while111111
	(setq e (nth i00 zzt))
	(if j00				;if j
	  (progn			;progn1
	    (setq listname3 (strcat "**" (nth i00 zzt)))
	    (setq
	      j00 nil
	    )
	    (apply 'zzttkfun ())
	    (setq zk1 (apply 'readfile (list filename3 listname3)))
	    (setq zkmc1 (nth 2 zk1))
	    (setq gcmc (nth 1 zk1))
	    (apply 'zzt1fun (list zk1 bzyxb))
	    (apply 'newqbct ())
    	    (command "_.color" "bylayer")
	  )				;end progn1
	  (progn			;progn2
	    (setq listname3 (strcat "**" (nth i00 zzt)))
	    (setq zk2 (apply 'readfile (list filename3 listname3)))
	    (setq zkmc2 (nth 2 zk2))
	    (apply 'zzt2fun (list zk2 bzyxb))
	  )				;end progn2
	)				;end if j
	(setq i00 (1+ i00))
      )					;end while11111111


(setq gcml (nth 30 gcwzb))
(setq txt1 (strcat gcml gcmc"--" zkmc1 " " zkmc2 "(" tjymh ")"))

(setq txt1 (strcat "c:/Gees2000/福建省第四地质大队岩土工程勘察专家系统/gcrtf/ " zkmc1 " " zkmc2 "(" tjymh")"))

(command
  "_.saveas"
  ""
  txt1
  "y"
)
(command)



      
    )
;;;end progn0000000000000000000000000000000000000
    (progn
;;;progn111111111111111111111
      (command "_.point" "-10,-20")
      (command "_.point" "-10,20")
      (command "_.point" "50,20")
      (command "_.point" "50,-20")
      (command "_.zoom" "e")
      (setq tp1 '(20 0))
      (setq txt1 "该 页 柱 状 图 不 存 在！")
      (command "_.color" 1)
      (command "_.text" "s" "style1" "m" tp1 2.8 0 txt1)
      (command "_.color" "bylayer")
    )
;;;end progn111111111111111111111
  )
;;;end if00000000000000000000000000000000000000000
  (setq	p001 '(0 0)
	p002 '(16.95 26)
  )
)					;end defun previewzzt

