

;;;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)

;;;;;;;;;;;开始绘制剖面图标贯及重2直方图函数
(defun bgzft(bgb pointx pointy vscale hscale)
;;;;;
  (if (/= bgb nil)
    (progn
      (setq i 0)
      (while (< i (- (length bgb) 3))
	(setq txt1 "")
	(if (= (nth 27 gcwzb) "1")
	  (setq a (nth (+ i 4) bgb))
	  (setq a (nth i bgb))
	)
	(setq txta a)
	(setq j 1)
	(while (>= (- (strlen a) j) 3)
	  (setq ft (substr a j 4))
	  (if (= ft "反弹")
	    (setq txt1 "反弹")
	  )
	  (setq j (1+ j))
	)
	;;endwhilen
	(setq b (- pointy (/ (atof (nth (1+ i) bgb)) vscale)))
	(setq c (- pointy (/ (atof (nth (+ i 2) bgb)) vscale)))
	(setq mbc(/(+ b c)2))
	(setq a (/ (atof a) hscale))
	(setq p1 (list pointx b))
	(setq p2 (list (+ pointx a) b))
	(setq p3 (list (+ pointx a) c))
	(setq p4 (list pointx c))
	(command "_.line" p1 p2 p3 p4 "")
	(if (= txt1 "反弹")
	  (progn
	    (setq p5 (list (+ pointx 3) c))
	    (command "_.line" p5 p4 "")
	    (command "_.text" "s" "style1" "ml" p5 0.20 0 "反弹")
	    (setq txt1 "")
	  )
	  (progn
	    (command "_.text" "s" "style1" "ml" (list (+ pointx a) mbc) 0.20 0 txta)
	    (setq txt1 "")
	  )
	  ;;endprogn
	)
;;;endif
	(setq i (+ i 5))
      )
;;;endwhile
    )
;;;;endprognbg
  )
;;;;endifbg

  (command "_.color" "bylayer")

;;;;;;end ifze

)


(defun zezft (bgb pointx pointy vscale hscale)
;;;;;

;;;;endifbg
  (if (/= zeb nil)
    (progn
      (setq i 0)
      (command "_.color" 240)
      (while (< i (- (length zeb) 3))
	(setq txt1 "")
	(if (= (nth 28 gcwzb) "1")
	  (setq a (nth (+ i 4) zeb))
	  (setq a (nth i 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 b (- pointy (/ (atof (nth (1+ i) zeb)) vscale)))
	(setq c (- pointy (/ (atof (nth (+ i 2) zeb)) vscale)))
	(setq p1 (list pointx b))
	(command "_.line" p1)

	(setq k 0)
	(repeat	(length zejs)
	  (setq a (nth k zejs))
	  (setq txta a)
	  (setq j 1)
	  (while (>= (- (strlen a) j) 3)
	    (setq ft (substr a j 4))
	    (if	(= ft "反弹")
	      (setq txt1 "反弹")
	    )
	    (setq j (1+ j))
	  )
	  ;;endwhilen
	  (setq a (/ (atof a) hscale))
	  (setq p2 (list (+ pointx a) b))
	  (setq b (- b (/ 0.1 vscale)))
	  (if (= txt1 "反弹")
	    (progn
	      (setq p3 (list (+ 3 pointx) (+ b (/ 0.1 vscale))))
	      (command p3)
	      (setq p5 (list pointx (cadr p3)))
	      (command p5 "")
	      (command "_.color" "bylayer")
	      (command "_.text" "s" "style1" "ml" p3 0.20 0 "反弹")
	      (setq txt1 "")
	      (command "_.color" 240)
	    )
	    ;;endprogn
	    (progn
	      (setq p3 (list (+ pointx a) b))
	      (command p2 p3 "")
	      (command "_.text" "s" "style1" "ml" p2 0.20 0 txta)
	      (command "_.line" p3)
	    )
;;;endprogn	      
	  )
;;;endif
	  (setq k (1+ k))
	)
;;;endrepeat
	(setq p5 (list pointx b))
	(command p3 p5 "")
	(setq i (+ i 5))
      )
;;;endwhile
    )
;;;;endprognbg
  )
;;;;endprognbg
  (command "_.color" "bylayer")

;;;;;;end ifze

)

;;;;;;;;;;结束绘制剖面图标贯及重2直方图函数

;end defun zzttkfun
(defun zzttkfun	(zk)
;;;;;
    (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 bgb nil)
  (setq zeb nil)
  (setq fchb nil)
  (setq cyfhb nil)
  (setq yyb nil)
  (setq lsdtb nil)
  (setq dtblc 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
  )					;end if---10


  (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
					;end if---10
 


(apply 'bgzft(list bgb 0 22 1 10))

(apply 'zezft(list zeb 0 22 1 10))
  
  
;;;endrepeat

  
  
;;;endrepeat

  (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 16) (fix (/ jsmax 16))) 0.5)
	(setq a 1)
	(setq a 0.5)
      )
      (if (and (= (/ jsmax 16) (fix (/ jsmax 16)))
	       (> (fix (/ jsmax 16)) 0)
	  )
	(setq a 0)
      )
      (setq dtbl (+ a (fix (/ jsmax 16))))

    )
;;;endprogn
  )
;;;end if

    

  (if (/= bgb nil)
    (progn
      (setq i 0)
      (while (< i (- (length bgb) 3))
	(setq txt1 "")
	(if (= (nth 27 gcwzb) "1")
	  (setq a (nth (+ i 4) bgb))
	  (setq a (nth i bgb))
	)
	(setq j 1)
	(while (>= (- (strlen a) j) 3)
	  (setq ft (substr a j 4))
	  (if (= ft "反弹")
	    (setq txt1 "反弹")
	  )
	  (setq j (1+ j))
	)
	;;endwhilen
	(setq b (- 22 (/ (atof (nth (1+ i) bgb)) dt)))
	(setq c (- 22 (/ (atof (nth (+ i 2) bgb)) dt)))
	(setq a (/ (atof a) dtbl))
	(setq p1 (list 20.7 b))
	(setq p2 (list (+ 20.7 a) b))
	(setq p3 (list (+ 20.7 a) c))
	(setq p4 (list 20.7 c))
	(command "_.line" p1 p2 p3 p4 "")
	(if (= txt1 "反弹")
	  (progn
	    (setq p5 (list 35.7 c))
	    (command "_.line" p5 p4 "")
	    (command "_.text" "s" "style1" "ml" p5 0.23 0 "反弹")
	    (setq txt1 "")
	  )
	  ;;endprogn
	)
;;;endif
	(setq i (+ i 5))
      )
;;;endwhile
    )
;;;;endprognbg
  )
;;;;endifbg





  (if (/= zeb nil)
    (progn
      (setq i 0)
      (command "_.color" 240)
      (while (< i (- (length zeb) 3))
	(setq txt1 "")
	(if (= (nth 28 gcwzb) "1")
	  (setq a (nth (+ i 4) zeb))
	  (setq a (nth i 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 b (- 22 (/ (atof (nth (1+ i) zeb)) dt)))
	(setq c (- 22 (/ (atof (nth (+ i 2) zeb)) dt)))
	(setq p1 (list 20.7 b))
	(command "_.line" p1)

	(setq k 0)
	(repeat	(length zejs)
	  (setq a (nth k zejs))
	  (setq j 1)
	  (while (>= (- (strlen a) j) 3)
	    (setq ft (substr a j 4))
	    (if	(= ft "反弹")
	      (setq txt1 "反弹")
	    )
	    (setq j (1+ j))
	  )
	  ;;endwhilen
	  (setq a (/ (atof a) dtbl))
	  (setq p2 (list (+ 20.7 a) b))
	  (setq b (- b (/ 0.1 dt)))
	  (if (= txt1 "反弹")
	    (progn
	      (setq p3 (list 35.7 (+ b (/ 0.1 dt))))
	      (command p3)
	      (setq p5 (list 20.7 (cadr p3)))
	      (command p5 "")
	      (command "_.color" "bylayer")
	      (command "_.text" "s" "style1" "ml" p3 0.23 0 "反弹")
	      (setq txt1 "")
	      (command "_.color" 240)
	    )
	    ;;endprogn
	    (progn
	      (setq p3 (list (+ 20.7 a) b))
	      (command p2 p3)
	    )
;;;endprogn	      
	  )
;;;endif
	  (setq k (1+ k))
	)
;;;endrepeat
	(setq p5 (list 20.7 b))
	(command p3 p5 "")
	(setq i (+ i 5))
      )
;;;endwhile
    )
;;;;endprognbg
  )
  (command "_.color" "bylayer")

;;;;;;end ifze

)






				;enddefun zzt2fun*******************************************************************************************************

				;enddefun zzt2fun*******************************************************************************************************

(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
	)

	
	

	(setq zk1 (apply 'readfile (list filename3 listname3)))
	(apply 'zzttkfun(list zk1))
      )					;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 '(37 26))
  )


