

(defun pmtprint	()
;;;;;;;;;;;;;;;;;;;*************************************************************************************************************************************************
  (setq plotstyle "other")
  (setq zzth 10000)
;;;;;;;;;;;;;;;;;;;*************************************************************************************************************************************************

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



  (defun pmzzt (zk bzyxb point blv)	;begin defun pmzzt0000000000000000000000000000000000000000000000000000000

    (setq p00 (list (- 23.7 (car point)) (- 22 (cadr point))))
;;;;;;;从岩性描述中查找对应的岩性花纹函数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 40) 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 (= 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 huawentc2 (bzyxb3 yxms ks1 ks2)
					;defunhuawentc2 (bzyxb3 yxms ks1 ks2)00000000000000000000000000000000000000000000000000
					;defunhuawentc2 (bzyxb3 yxms ks1 ks2)00000000000000000000000000000000000000000000000000
					;defunhuawentc2 (bzyxb3 yxms ks1 ks2)00000000000000000000000000000000000000000000000000
					;defunhuawentc2 (bzyxb3 yxms ks1 ks2)00000000000000000000000000000000000000000000000000
					;defunhuawentc2 (bzyxb3 yxms ks1 ks2)00000000000000000000000000000000000000000000000000
					;defunhuawentc2 (bzyxb3 yxms ks1 ks2)00000000000000000000000000000000000000000000000000
					;defunhuawentc2 (bzyxb3 yxms ks1 ks2)00000000000000000000000000000000000000000000000000
					;defunhuawentc2 (bzyxb3 yxms ks1 ks2)00000000000000000000000000000000000000000000000000
					;defunhuawentc2 (bzyxb3 yxms ks1 ks2)00000000000000000000000000000000000000000000000000
					;defunhuawentc2 (bzyxb3 yxms ks1 ks2)00000000000000000000000000000000000000000000000000
					;defunhuawentc2 (bzyxb3 yxms ks1 ks2)00000000000000000000000000000000000000000000000000
      (setq bzyxb1 '("全风化"	 "强风化"    "中风化"	 "弱风化"
		     "微风化"	 "粗砂"	     "中砂"	 "细砂"
		     "粉砂"	 "根植土"    "种植土"	 "圆砾"
		     "砾砂"
		    )
      )


      (setq yx nil)
      (setq qcyx (apply 'qcyxm (list yxms)))
      (setq yx (apply 'qdyx (list bzyxb1 qcyx)))
      (if (or (= yx "全风化")
	      (= yx "强风化")
	      (= yx "中风化")
	      (= yx "弱风化")
	      (= yx "微风化")
	      (= yx "根植土")
	      (= yx "种植土")
	  )
	(setq yx0 (strcat yx0 yx))
      )
;;;end if
      (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 ks1) 1.3) 1.5) ;if1
		 (progn	;;progn1
			(setq m (- ks2 ks1))
			(setq p1 (list (- 23.15 (car p00))
				       (- (- 22 ks1 (/ m 2)) (cadr p00))
				 )
			      p2 (list (- 24.25 (car p00))
				       (- (- 22 ks1 (/ m 2)) (cadr p00))
				 )
			)
			(command "_.minsert" fileyx p1 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 (car p00))
				  (- (- 22 ks1 (/ m 2)) (cadr p00))
			    )
		   )
		   (setq m1 (- 0 m))
		   (command "_.minsert" fileyx p1 1 1 "" n 1 m1)
		 )			;endprogn2
	       )			;end if1
	     )				;endprogn111111111111111111
	   )				;endif11111111111111111111111

	 )				;endprogn1
	)				;3
	((= yx "砾砂")
	 (progn				;progn1
	   (setq m (- ks2 ks1))
	   (setq p1 (list (- 23.15 (car p00))
			  (- (- 22 ks1 (/ m 2)) (cadr p00))
		    )
	   )
	   (command "_.text" "s" "style1" "m" p1 0.16 0 "(L)")
	 )				;end progn1	
	)				;6
	((= yx "粗砂")
	 (progn				;progn1
	   (setq m (- ks2 ks1))
	   (setq p1 (list (- 23.15 (car p00))
			  (- (- 22 ks1 (/ m 2)) (cadr p00))
		    )
	   )
	   (command "_.text" "s" "style1" "m" p1 0.16 0 "(c)")
	 )				;end progn1	
	)				;6

	((= yx "中砂")
	 (progn				;progn1
	   (setq m (- ks2 ks1))
	   (setq p1 (list (- 23.15 (car p00))
			  (- (- 22 ks1 (/ m 2)) (cadr p00))
		    )
	   )
	   (command "_.text" "s" "style1" "m" p1 0.16 0 "(z)")
	 )				;end progn1	
	)				;7

	((= yx "细砂")
	 (progn				;progn1
	   (setq m (- ks2 ks1))
	   (setq p1 (list (- 23.15 (car p00))
			  (- (- 22 ks1 (/ m 2)) (cadr p00))
		    )
	   )
	   (command "_.text" "s" "style1" "m" p1 0.16 0 "(x)")
	 )				;end progn1	
	)				;8

	((= yx "粉砂")
	 (progn				;progn1
	   (setq m (- ks2 ks1))
	   (setq p1 (list (- 23.15 (car p00))
			  (- (- 22 ks1 (/ m 2)) (cadr p00))
		    )
	   )
	   (command "_.text" "s" "style1" "m" p1 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))
		 (setq p1 (list	(- 23.15 (car p00))
				(- (- 22 ks1 0.1) (cadr p00))
			  )
		 )
		 (command "_.insert" "d:/1/根植土" p1 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))
		   (setq p1
			  (list	(- 23.15 (car p00))
				(- (- 22 ks1 (* m i) (- (/ m 2))) (cadr p00))
			  )
		   )
		   (command "_.insert" "d:/1/根植土" p1 0.8 0.8 "")
		 )			;repeat
	       )			;endprogn2
	     )				;end if1
	   )				;end if1111111111111
	 )				;progn1
	)				;12
	(t (setq yx nil))
      )					;end cond '("全风化"	  "强风化"   "中风化"	"弱风化"   "微风化"  "粗砂"	  "中砂"     "细砂"	"粉砂"	   "晶屑"   "熔结" "根植土" "种植土")
					;end cond '("全风化"	  "强风化"   "中风化"	"弱风化"   "微风化"  "粗砂"	  "中砂"     "细砂"	"粉砂"	   "晶屑"   "熔结" "根植土" "种植土")
      (setq yx nil)
      (setq qcyx (apply 'qcyxm (list yxms)))
      (setq yx (apply 'qdyx (list '("晶屑") qcyx)))

;;;end if
      (if (= yx "晶屑")
	(progn				;progn1
	  (if (< (/ (- ks2 ks1) 0.6) 1)	;if1
	    (progn
	      (setq m (- ks2 ks1))
	      (setq p1 (list (- 23.4 (car p00))
			     (- (- 22 ks1 (/ m 2)) (cadr p00))
		       )
	      )
	      (command "_.text" "s" "style1" "m" p1 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))
		(setq
		  p1
		   (list (- (- 23.15 (car p00)) PY)
			 (- (- 22 ks1 (* m i) (- (/ m 2))) (cadr p00))
		   )
		)
		(command "_.text" "s" "style1" "m" p1 0.16 0 "J")
	      )				;repeat
	    )				;endprogn2
	  )				;end if1

	)				;progn1
      )					;end if "晶屑"
      (setq yx "")
      (setq qcyx (apply 'qcyxm (list yxms)))
      (setq yx (apply 'qdyx (list '("熔结") qcyx)))

      ;;end if
      (if (= yx "熔结")
	(progn				;progn1
	  (if (< (/ (- ks2 ks1) 0.6) 1)	;if1
	    (progn
	      (setq m (- ks2 ks1))
	      (setq p1 (list (- 22.9 (car p00))
			     (- (- 22 ks1 (/ m 2)) (cadr p00))
		       )
	      )
	      (command "_.text" "s" "style1" "m" p1 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)
		)

		(setq
		  p1
		   (list (+ (- 23.15 (car p00)) PY)
			 (- (- 22 ks1 (* m i) (- (/ m 2))) (cadr p00))
		   )
		)
		(command "_.text" "s" "style1" "m" p1 0.16 ant "ω")

	      )				;repeat
	    )				;endprogn2
	  )				;end if1

	)				;progn1
      )					;end if"熔结"

      (setq yx nil)
      (setq qcyx (apply 'qcyxm (list yxms)))
      (setq yx (apply 'qdyxm (list bzyxb3 qcyx)))
      (if (/= yx nil)
	(setq yx0 (strcat yx0 yx))
      )
;;;end if
      (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 ks1) 0.45) 1.5) ;if1
	    (progn ;;progn1
		   (setq m (- ks2 ks1))
		   (setq p1 (list (- 22.925 (car p00))
				  (- (- 22 ks1 (/ m 2)) (cadr p00))
			    )
		   )
		   (setq m2 (/ m 0.45))
		   (command "_.minsert" fileyx p1 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 (car p00))
			     (- (- 22 ks1 (/ m 2)) (cadr p00))
		       )
	      )
	      (setq m1 (- 0 m))
	      (setq m2 (/ m 0.45))
	      (command "_.minsert" fileyx p1 1 m2 "" n 2 m1 0.45)
	    )				;endprogn2
	  )				;end if1

	)				;endprogn111111111111111111
      )					;endif11111111111111111111111
    )					;end defun huawentc2(bzyxb3 yxms ks1 ks2)00000000000000000000000000000000000000000000000000000000000000000000000000
					;end defun huawentc2(bzyxb3 yxms ks1 ks2)00000000000000000000000000000000000000000000000000000000000000000000000000
					;end defun huawentc2(bzyxb3 yxms ks1 ks2)00000000000000000000000000000000000000000000000000000000000000000000000000
					;end defun huawentc2(bzyxb3 yxms ks1 ks2)00000000000000000000000000000000000000000000000000000000000000000000000000
					;end defun huawentc2(bzyxb3 yxms ks1 ks2)00000000000000000000000000000000000000000000000000000000000000000000000000
					;end defun huawentc2(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 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	(/= yzyb nil)
      (setq yzyt t)
    )
    (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	(/= ldyb nil)
      (setq ldyt t)
    )
    (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	(/= bgb nil)
      (setq bgt t)
    )
    (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	(/= zeb nil)
      (setq zet t)
    )

    (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	(/= yyb nil)
      (setq yyt t)
    )
;;;;;;以下部份为岩土花纹自动填充
;;;;;;以下部份为岩土花纹自动填充
;;;;;;以下部份为岩土花纹自动填充
;;;;;;以下部份为岩土花纹自动填充
;;;;;;以下部份为岩土花纹自动填充
;;;;;;以下部份为岩土花纹自动填充


    (setq i11 0
	  dkyxb	nil
	  dkdb nil
    )
    (repeat (1- (length ksb))		;repeat00000000000000000000000000000000000000000000
      (setq ks1p (atof (nth i11 ksb)))
      (setq ks1 (/ ks1p (/ (atof blv) 100)))
      (setq yxms (nth i11 yxmsb))
      (setq i11 (1+ i11))
      (setq ks2p (atof (nth i11 ksb)))
      (setq ks2 (/ ks2p (/ (atof blv) 100)))
      (setq fcd nil)
      (setq fcd (list (car point) (- (cadr point) ks2)))
      (setq yx0 "")
      (apply 'huawentc2 (list bzyxb yxms ks1 ks2))
      (setq dkyxb (append dkyxb (list yx0)))
      (setq dkdb (append dkdb (list fcd)))
    )					;end repeat0000000000000000000000000000000000000000000000000




    (if	(= (nth 15 gcwzb) "1")
      (progn
;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;
	(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 blv) 100)))
	    (setq d (/ (+ (atof b) (atof c)) (/ (atof blv) 100)))
	  )				;end if
	  (setq	p1  (list (- 23.3 (car p00)) (- (- 22 d) (cadr p00)))
		tp1 (list (- 22.7 (car p00)) (- (- 22 d) (cadr p00)))
	  )
	  (command "_.text" "s" "style1" "mr" tp1 0.21 0 a)

	  (if (= (nth 15 gcwzb) "1")
	    (if	(findfile "c:/gees2000/岩土花纹/原状样.dwg")
	      (command "_.insert"
		       "c:/gees2000/岩土花纹/原状样.dwg"
		       p1		    1
		       1		    ""
		      )
	    )
	  )

	  (command)
	)				;end repeat000000000000000000000000000000000000000000
      )
;;;end progn
    )
;;;endif
    (if	(= (nth 16 gcwzb) "1")
      (progn
	(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 blv) 100)))
	    (setq d (/ (+ (atof b) (atof c)) (/ (atof blv) 100)))
	  )				;end if
	  (setq	p1  (list (- 23.3 (car p00)) (- (- 22 d) (cadr p00)))
		tp1 (list (- 22.7 (car p00)) (- (- 22 d) (cadr p00)))
	  )
	  (command "_.text" "s" "style1" "mr" tp1 0.21 0 a)
	  (if (= (nth 16 gcwzb) "1")
	    (if	(findfile "c:/gees2000/岩土花纹/扰动样.dwg")
	      (command "_.insert"
		       "c:/gees2000/岩土花纹/扰动样.dwg"
		       p1		    1
		       1		    ""
		      )
	    )
	  )
	  (command)
	)				;end repeat000000000000000000000000000000000000000000
      )
;;;endprogn
    )
;;;;endif



    (if	(= (nth 16 gcwzb) "1")
      (progn
	(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 blv) 100)))
	    (setq d (/ (+ (atof b) (atof c)) (/ (atof blv) 100)))
	  )				;end if
	  (setq	f (/ (- (atof c) (atof b)) (/ (atof blv) 100) 0.45)
		f (abs f)
	  )
	  (if (= f 0)
	    (setq f 0.612)
	  )

	  (setq	p1  (list (- 23.3 (car p00)) (- (- 22 d) (cadr p00)))
		tp1 (list (- 22.7 (car p00)) (- (- 22 d) (cadr p00)))
	  )
	  (command "_.text" "s" "style1" "mr" tp1 0.21 0 a)
	  (if (= (nth 16 gcwzb) "1")
	    (if	(findfile "c:/gees2000/岩土花纹/岩样.dwg")
	      (command "_.insert"
		       "c:/gees2000/岩土花纹/岩样.dwg"
		       p1		   1
		       f		   ""
		      )
	    )
	  )
	  (command)
	)				;end repeat000000000000000000000000000000000000000000
      )
;;;endprogn
    )
;;;;endif



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

	(setq i	 0
	      ch (/ (length bgb) 5)
	)
	(repeat	ch			;repeat 00000000000000000000000000000
	  (setq	a (nth i bgb)
		b (nth (1+ i) bgb)
		c (nth (+ i 2) bgb)
	  )
	  (if (= (nth 27 gcwzb) "1")
	    (setq a (nth (+ i 4) bgb))
	  )
	  (setq i (+ i 5))
	  (if (and (/= b "") (/= c ""))
	    (setq d (/ (+ (atof b) (atof c)) 2 (/ (atof blv) 100)))
	    (setq d (/ (+ (atof b) (atof c)) (/ (atof blv) 100)))
	  )				;end if
	  (if (= (substr a 1 1) ">")
	    (setq f (strcat "N" a))
	    (setq f (strcat "N=" a))
	  )
	  (setq	p1  (list (- 24.1 (car p00)) (- (- 22 d) (cadr p00)))
		tp1 (list (- 25 (car p00)) (- (- 22 d) (cadr p00)))
	  )
	  (command "_.text" "s" "style1" "ml" tp1 0.21 0 f)
	  (command)
	  (setq p1p (list (car p1) (- (cadr p1) 0.15)))
	  (if (findfile "c:/gees2000/岩土花纹/标贯.dwg")
	    (command "_.insert"		 "c:/gees2000/岩土花纹/标贯.dwg"
		     p1			 1
		     1			 ""
		    )
	  )
	  (command)
	)				;end repeat000000000000000000000000000000000000000000
      )
;;;endprogn
    )
;;;endif


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

	(setq i	 0
	      ch (/ (length zeb) 5)
	)
	(repeat	ch			;repeat 00000000000000000000000000000
	  (setq	a (nth i zeb)
		b (nth (1+ i) zeb)
		c (nth (+ i 2) zeb)
	  )
	  (if (= (nth 28 gcwzb) "1")
	    (setq a (nth (+ i 4) zeb))
	  )
	  (setq i (+ i 5))
	  (if (and (/= b "") (/= c ""))
	    (setq d (/ (+ (atof b) (atof c)) 2 (/ (atof blv) 100)))
	    (setq d (/ (+ (atof b) (atof c)) (/ (atof blv) 100)))
	  )				;end if
	  (setq f (strcat "N'=" a))
	  (setq	p1  (list (- 24.1 (car p00)) (- (- 22 d) (cadr p00)))
		tp1 (list (- 25 (car p00)) (- (- 22 d) (cadr p00)))
	  )
	  (command "_.text" "s" "style1" "ml" tp1 0.21 0 f)
	  (command)
	  (setq p1p (list (car p1) (+ (cadr p1) 0.12)))
	  (setq p1e (list (car p1) (- (cadr p1) 0.15)))
	  (if (findfile "c:/gees2000/岩土花纹/重2.dwg")
	    (command "_.insert"		 "c:/gees2000/岩土花纹/重2.dwg"
		     p1			 1
		     1			 ""
		    )
	  )
	  (command)
	)				;end repeat000000000000000000000000000000000000000000
      )
;;;endprogn
    )
;;;endif
;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;
    (setq n 1)
    (setq kg (nth 4 zhb))
    (repeat (- (length ksb) 1)		;repeat1
      (progn				;progn1
	(setq ks (atof (nth n ksb)))
	(progn				;progn3
	  (setq
	    p1 (list (- 22.7 (car p00))
		     (- (- 22 (/ ks (/ (atof blv) 100))) (cadr p00))
	       )
	  )
	  (setq
	    p2 (list (- 23.6 (car p00))
		     (- (- 22 (/ ks (/ (atof blv) 100))) (cadr p00))
	       )
	  )
	  (setq
	    p3 (list (- 23.8 (car p00))
		     (- (- 22 (/ ks (/ (atof blv) 100))) (cadr p00))
	       )
	  )
	  (setq
	    p4 (list (- 24.7 (car p00))
		     (- (- 22 (/ ks (/ (atof blv) 100))) (cadr p00))
	       )
	  )
	  (setq	tp1
		 (list (- 23.8 (car p00))
		       (- (- 22 (/ ks (/ (atof blv) 100)) -0.13) (cadr p00))
		 )
	  )
	)				;end progn3
	(command "_.pline" p1 "w" 0.013 "" p2 "")
	(command "_.pline" p3 "w" 0.013 "" p4 "")
					;write number
	(setq txt1 (rtos ks 2 2))
	(setq txt3p (rtos (- (atof kg) ks) 2 2))
	(setq txt3 (strcat "(" txt3p ")"))
	(setq txt (strcat txt1 txt3))
	(command "_.text" "s" "style1" "j" "ml" tp1 0.2 0 txt)
					;write number
	(setq n (+ 1 n))
      )					;progn1
    )					;end repeat


    (setq p1 (list (- 23.6 (car p00)) (- 22 (cadr p00)))
	  p2 (list (- 23.8 (car p00)) (- 22 (cadr p00)))
	  p3 (list (- 23.6 (car p00))
		   (- (- 22 (/ (atof (last ksb)) (/ (atof blv) 100)))
		      (cadr p00)
		   )
	     )
	  p4 (list (- 23.8 (car p00))
		   (- (- 22 (/ (atof (last ksb)) (/ (atof blv) 100)))
		      (cadr p00)
		   )
	     )
    )
    (command "_.pline" p1 "w" 0.013 "" p3 "")
    (command "_.pline" p2 "w" 0.013 "" p4 "")
    (command "_.pline" p3 "w" 0.013 "" p4 "")
    (setq txt (nth 1 zhb)
	  tp1 (list (- 23.7 (car p00)) (- 22.5 (cadr p00)))
    )
    (command "_.text" "s" "style1" "j" "m" tp1 0.3 0 txt)


    (if	(= (nth 14 gcwzb) "1")
      (progn
	(setq swp (nth 12 zhb))
	(if (and (/= swp "")
		 (/= swp " ")
		 (/= swp "  ")
		 (/= swp "   ")
		 (/= swp "干孔")
		 (/= swp "干")
		 (/= swp "无")
		 (/= swp "无水")
	    )
	  (progn
	    (setq swp (/ (atof swp) (/ (atof blv) 100)))
	    (setq sw (list (car point) (- (cadr point) swp)))
	    (setq p10 (list (- (car sw) 0.15) (+ (cadr sw) 0.3)))
	    (setq p20 (list (+ (car sw) 0.15) (+ (cadr sw) 0.3)))
	    (command "_.pline" sw "w" 0.013 "" p10 p20 sw "")
	    (setq p10 (list (- (car sw) 0.15) (- (cadr sw) 0)))
	    (setq p20 (list (+ (car sw) 0.15) (- (cadr sw) 0)))
	    (command "_.pline" p10 "w" 0.013 "" p20 "")
	    (setq p10 (list (- (car sw) 0.1) (- (cadr sw) 0.08)))
	    (setq p20 (list (+ (car sw) 0.1) (- (cadr sw) 0.08)))
	    (command "_.pline" p10 "w" 0.013 "" p20 "")
	    (setq p10 (list (- (car sw) 0.05) (- (cadr sw) 0.16)))
	    (setq p20 (list (+ (car sw) 0.05) (- (cadr sw) 0.16)))
	    (command "_.pline" p10 "w" 0.013 "" p20 "")
	  )
;;;end progn
	  (setq sw (list 10000 10000))
	)
;;;end if
      )
;;;end if
    )
;;;endif

    (setq lczhb (append lczhb (list (nth 14 zhb))))
  )					;end defun pmzzt000000000000000000000000000000000000000000000000000000000000000000000000000000000

















;;;end defun writefch

















  ;;end defunpmlx









  (defun tlfun ()

    (defun huawentc3 (bzyxb3 yxms ks1 ks2)
					;defunhuawentc3 (bzyxb3 yxms ks1 ks2)00000000000000000000000000000000000000000000000000
					;defunhuawentc3 (bzyxb3 yxms ks1 ks2)00000000000000000000000000000000000000000000000000
					;defunhuawentc3 (bzyxb3 yxms ks1 ks2)00000000000000000000000000000000000000000000000000
					;defunhuawentc3 (bzyxb3 yxms ks1 ks2)00000000000000000000000000000000000000000000000000
					;defunhuawentc3 (bzyxb3 yxms ks1 ks2)00000000000000000000000000000000000000000000000000
					;defunhuawentc3 (bzyxb3 yxms ks1 ks2)00000000000000000000000000000000000000000000000000
					;defunhuawentc3 (bzyxb3 yxms ks1 ks2)00000000000000000000000000000000000000000000000000
					;defunhuawentc3 (bzyxb3 yxms ks1 ks2)00000000000000000000000000000000000000000000000000
					;defunhuawentc3 (bzyxb3 yxms ks1 ks2)00000000000000000000000000000000000000000000000000
					;defunhuawentc3 (bzyxb3 yxms ks1 ks2)00000000000000000000000000000000000000000000000000
					;defunhuawentc3 (bzyxb3 yxms ks1 ks2)00000000000000000000000000000000000000000000000000

      (setq bzyxb1 '("全风化"	 "强风化"    "中风化"	 "弱风化"
		     "微风化"	 "粗砂"	     "中砂"	 "细砂"
		     "粉砂"	 "根植土"    "种植土"	 "圆砾"
		     "砾砂"
		    )
      )


      (setq yx nil)
      (setq qcyx (apply 'qcyxm (list yxms)))
      (setq yx (apply 'qdyx (list bzyxb1 qcyx)))
      (if (or (= yx "全风化")
	      (= yx "强风化")
	      (= yx "中风化")
	      (= yx "弱风化")
	      (= yx "微风化")
	      (= yx "根植土")
	      (= yx "种植土")
	  )
	(setq yx0 (strcat yx0 yx))
      )
;;;end if
      (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 ks1) 1.3) 1.5) ;if1
		 (progn	;;progn1
			(setq m (- ks2 ks1))
			(setq p1 (list (- 23.15 (car p00))
				       (- (- 22 ks1 (/ m 2)) (cadr p00))
				 )
			      p2 (list (- 24.25 (car p00))
				       (- (- 22 ks1 (/ m 2)) (cadr p00))
				 )
			)
			(command "_.minsert" fileyx p1 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 (car p00))
				  (- (- 22 ks1 (/ m 2)) (cadr p00))
			    )
		   )
		   (setq m1 (- 0 m))
		   (command "_.minsert" fileyx p1 1 1 "" n 1 m1)
		 )			;endprogn2
	       )			;end if1
	     )				;endprogn111111111111111111
	   )				;endif11111111111111111111111

	 )				;endprogn1
	)				;3
	((= yx "砾砂")
	 (progn				;progn1
	   (setq m (- ks2 ks1))
	   (setq p1 (list (- 23.15 (car p00))
			  (- (- 22 ks1 (/ m 2)) (cadr p00))
		    )
	   )
	   (command "_.text" "s" "style1" "m" p1 0.16 0 "(L)")
	 )				;end progn1	
	)				;6
	((= yx "粗砂")
	 (progn				;progn1
	   (setq m (- ks2 ks1))
	   (setq p1 (list (- 23.15 (car p00))
			  (- (- 22 ks1 (/ m 2)) (cadr p00))
		    )
	   )
	   (command "_.text" "s" "style1" "m" p1 0.16 0 "(c)")
	 )				;end progn1	
	)				;6

	((= yx "中砂")
	 (progn				;progn1
	   (setq m (- ks2 ks1))
	   (setq p1 (list (- 23.15 (car p00))
			  (- (- 22 ks1 (/ m 2)) (cadr p00))
		    )
	   )
	   (command "_.text" "s" "style1" "m" p1 0.16 0 "(z)")
	 )				;end progn1	
	)				;7

	((= yx "细砂")
	 (progn				;progn1
	   (setq m (- ks2 ks1))
	   (setq p1 (list (- 23.15 (car p00))
			  (- (- 22 ks1 (/ m 2)) (cadr p00))
		    )
	   )
	   (command "_.text" "s" "style1" "m" p1 0.16 0 "(x)")
	 )				;end progn1	
	)				;8

	((= yx "粉砂")
	 (progn				;progn1
	   (setq m (- ks2 ks1))
	   (setq p1 (list (- 23.15 (car p00))
			  (- (- 22 ks1 (/ m 2)) (cadr p00))
		    )
	   )
	   (command "_.text" "s" "style1" "m" p1 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))
		 (setq p1 (list	(- 23.15 (car p00))
				(- (- 22 ks1 0.1) (cadr p00))
			  )
		 )
		 (command "_.insert" "d:/1/根植土" p1 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))
		   (setq p1
			  (list	(- 23.15 (car p00))
				(- (- 22 ks1 (* m i) (- (/ m 2))) (cadr p00))
			  )
		   )
		   (command "_.insert" "d:/1/根植土" p1 0.8 0.8 "")
		 )			;repeat
	       )			;endprogn2
	     )				;end if1
	   )				;end if1111111111111
	 )				;progn1
	)				;12
	(t (setq yx nil))
      )					;end cond '("全风化"	  "强风化"   "中风化"	"弱风化"   "微风化"  "粗砂"	  "中砂"     "细砂"	"粉砂"	   "晶屑"   "熔结" "根植土" "种植土")
					;end cond '("全风化"	  "强风化"   "中风化"	"弱风化"   "微风化"  "粗砂"	  "中砂"     "细砂"	"粉砂"	   "晶屑"   "熔结" "根植土" "种植土")
      (setq yx nil)
      (setq qcyx (apply 'qcyxm (list yxms)))
      (setq yx (apply 'qdyx (list '("晶屑") qcyx)))
;;;end if
      (if (= yx "晶屑")
	(progn				;progn1
	  (if (< (/ (- ks2 ks1) 0.6) 1)	;if1
	    (progn
	      (setq m (- ks2 ks1))
	      (setq p1 (list (- 23.4 (car p00))
			     (- (- 22 ks1 (/ m 2)) (cadr p00))
		       )
	      )
	      (command "_.text" "s" "style1" "m" p1 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))
		(setq
		  p1 (list
		       (- (- 23.15 (car p00)) PY)
		       (- (- 22 ks1 (* m i) (- (/ m 2))) (cadr p00))
		     )
		)
		(command "_.text" "s" "style1" "m" p1 0.16 0 "J")
	      )				;repeat
	    )				;endprogn2
	  )				;end if1

	)				;progn1
      )					;end if "晶屑"
      (setq yx "")
      (setq qcyx (apply 'qcyxm (list yxms)))
      (setq yx (apply 'qdyx (list '("熔结") qcyx)))

      ;;end if
      (if (= yx "熔结")
	(progn				;progn1
	  (if (< (/ (- ks2 ks1) 0.6) 1)	;if1
	    (progn
	      (setq m (- ks2 ks1))
	      (setq p1 (list (- 22.9 (car p00))
			     (- (- 22 ks1 (/ m 2)) (cadr p00))
		       )
	      )
	      (command "_.text" "s" "style1" "m" p1 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)
		)

		(setq
		  p1 (list
		       (+ (- 23.15 (car p00)) PY)
		       (- (- 22 ks1 (* m i) (- (/ m 2))) (cadr p00))
		     )
		)
		(command "_.text" "s" "style1" "m" p1 0.16 ant "ω")

	      )				;repeat
	    )				;endprogn2
	  )				;end if1

	)				;progn1
      )					;end if"熔结"

      (setq yx nil)
      (setq qcyx (apply 'qcyxm (list yxms)))
      (setq yx (apply 'qdyxm (list bzyxb3 qcyx)))
      (if (/= yx nil)
	(setq yx0 (strcat yx0 yx))
      )
;;;end if
      (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 ks1) 0.45) 1.5) ;if1
	    (progn ;;progn1
		   (setq m (- ks2 ks1))
		   (setq p1 (list (- 22.925 (car p00))
				  (- (- 22 ks1 (/ m 2)) (cadr p00))
			    )
		   )
		   (setq m2 (/ m 0.45))
		   (command "_.minsert" fileyx p1 1 1 "" 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 (car p00))
			     (- (- 22 ks1 (/ m 2)) (cadr p00))
		       )
	      )
	      (setq m1 (- 0 m))
	      (setq m2 (/ m 0.45))
	      (command "_.minsert" fileyx p1 1 m2 "" n 2 m1 0.45)
	    )				;endprogn2
	  )				;end if1

	)				;endprogn111111111111111111
      )					;endif11111111111111111111111
    )					;end defun huawentc3(bzyxb3 yxms ks1 ks2)00000000000000000000000000000000000000000000000000000000000000000000000000
					;end defun huawentc3(bzyxb3 yxms ks1 ks2)00000000000000000000000000000000000000000000000000000000000000000000000000
					;end defun huawentc3(bzyxb3 yxms ks1 ks2)00000000000000000000000000000000000000000000000000000000000000000000000000
					;end defun huawentc3(bzyxb3 yxms ks1 ks2)00000000000000000000000000000000000000000000000000000000000000000000000000
					;end defun huawentc3(bzyxb3 yxms ks1 ks2)00000000000000000000000000000000000000000000000000000000000000000000000000
					;end defun huawentc3(bzyxb3 yxms ks1 ks2)00000000000000000000000000000000000000000000000000000000000000000000000000



    (setq c nil)
    (setq bbb '("分层孔深（标高）")
    )
    (if	yzyt
      (setq bbb (append bbb (list "原状样取样位置及编号")))
    )
    (if	ldyt
      (setq bbb (append bbb (list "扰动样取样位置及编号")))
    )

    (if	yyt
      (setq bbb (append bbb (list "岩样取样位置及编号")))
    )

    (if	bgt
      (setq bbb (append bbb (list "标贯试验位置及成果")))
    )
    (if	zet
      (setq bbb (append bbb (list "重(Ⅱ)试验位置及成果")))
    )

    (if	swt
      (setq bbb (append bbb (list "地下水位")))
    )

    (if	fcht
      (setq bbb (append bbb (list "分层号")))
    )



    (setq c (append b bbb))
    (setq tp1 (list (- (car p002) 2.43) (- (cadr p002) 4)))
    (command "_.text" "s" "style1" "m" tp1 0.3 0 "图  例")
    (setq p1 (list (- (car tp1) 0.65) (- (cadr tp1) 0.23)))
    (setq p2 (list (+ (car tp1) 0.65) (- (cadr tp1) 0.23)))
    (setq p3 (list (- (car tp1) 0.65) (- (cadr tp1) 0.33)))
    (setq p4 (list (+ (car tp1) 0.65) (- (cadr tp1) 0.33)))
    (command "_.pline" p1 "w" 0.013 "" p2 "")
    (command "_.pline" p3 "w" 0.013 "" p4 "")
    (setq
      jj (/ (float (- (cadr p002) (cadr p001) 8)) (1+ (length c)))
    )
    (setq p1 (list (- (car tp1) 1.6) (- (cadr tp1) 0.3 jj)))
    (setq p2 (list (- (car tp1) 0.7) (- (cadr tp1) 0.75 jj)))
    (command "_.rectang" "w" 0.013 p1 p2)
    (command "_.array" p1 p2 "" "r" (length c) "" (- jj))
    (setq i 0
	  x (+ (car p1) 1.1)
	  y (+ (cadr p1) -0.225 jj)
    )
    (repeat (length c)
;;;repeat00000000000000000000000000
      (setq d (nth i c)
	    i (1+ i)
      )
      (setq y (- y jj))
      (setq e (list x y))
      (command "_.mtext" e "s" "style1"	"j" "ml" "h" 0.2 "w" 2.85 d "")
    )
    ;;end repeat00000000000000000000000000000000000000


    (cond
      ((= (nth 11 gcwzb) "1") (setq tltxt "①"))
      ((or (= (nth 11 gcwzb) "2") (= (nth 11 gcwzb) "5"))
       (setq tltxt "Ⅰ")
      )
      ((or (= (nth 11 gcwzb) "3") (= (nth 11 gcwzb) "6"))
       (setq tltxt "A")
      )
      ((= (nth 11 gcwzb) "4")
       (setq tltxt "1")
      )

    )




    (setq i 0)
    (if	fcht
      (progn
	(setq tp1 (list (- x 0.65) y))
	(command "_.text" "s" "style1" "m" tp1 0.23 0 tltxt)
	(setq i (1+ i))
      )
      ;;end progn
    )
;;;end if


    (if	(and swt (= (nth 14 gcwzb) "1"))
      (progn
	(setq tp1 (list (- x 0.65) (+ y (* i jj))))
	(setq tp2 (list (- x 0.55) (+ y (* i jj) 0.16)))
	(setq tp3 (list (- x 0.75) (+ y (* i jj) 0.16)))
	(command "_.pline" tp1 "w" 0.013 "" tp2 tp3 tp1 "")
	(setq tp2 (list (- x 0.75) (+ y (* i jj))))
	(setq tp3 (list (- x 0.55) (+ y (* i jj))))
	(command "_.pline" tp2 "w" 0.013 "" tp3 "")
	(setq tp2 (list (- x 0.72) (+ y (* i jj) -0.08)))
	(setq tp3 (list (- x 0.58) (+ y (* i jj) -0.08)))
	(command "_.pline" tp2 "w" 0.013 "" tp3 "")
	(setq tp2 (list (- x 0.69) (+ y (* i jj) -0.16)))
	(setq tp3 (list (- x 0.62) (+ y (* i jj) -0.16)))
	(command "_.pline" tp2 "w" 0.013 "" tp3 "")
	(setq i (1+ i))
      )
;;;endprogn
    )
;;;end if


    (if	(and zet (= (nth 18 gcwzb) "1"))
      (progn
	(setq tp2 (list (- x 0.95) (+ y (* i jj) 0.1)))
	(setq tp3 (list (- x 0.95) (+ y (* i jj) -0.1)))
	(setq tp2 (list (- x 0.95) (+ y (* i jj))))
	(if (findfile "c:/gees2000/岩土花纹/重2.dwg")
	  (command "_.insert"	       "c:/gees2000/岩土花纹/重2.dwg"
		   tp2		       1
		   1		       ""
		  )
	)
	(setq tp1 (list (- x 0.75) (+ y (* i jj))))
	(setq txt1 "N'=19")
	(command "_.text" "s" "style1" "ml" tp1 0.16 0 txt1)
	(setq i (1+ i))
      )
;;;endprogn
    )
;;;end if

    (if	(and bgt (= (nth 17 gcwzb) "1"))
      (progn
	(setq tp2 (list (- x 0.95) (+ y (* i jj))))
	(setq tp3 (list (- x 0.95) (+ y (* i jj) -0.1)))
	(if (findfile "c:/gees2000/岩土花纹/标贯.dwg")
	  (command "_.insert"	       "c:/gees2000/岩土花纹/标贯.dwg"
		   tp2		       1
		   1		       ""
		  )
	)
	(setq tp1 (list (- x 0.75) (+ y (* i jj))))
	(setq txt1 "N=9.3")
	(command "_.text" "s" "style1" "ml" tp1 0.16 0 txt1)
	(setq i (1+ i))
      )
;;;endprogn
    )
;;;end if



    (if	(and yyt (= (nth 16 gcwzb) "1"))
      (progn
	(setq tp2 (list (- x 0.4) (+ y (* i jj))))
	(if (findfile "c:/gees2000/岩土花纹/岩样.dwg")
	  (command "_.insert"	       "c:/gees2000/岩土花纹/岩样.dwg"
		   tp2		       1
		   1		       ""
		  )
	)
	(setq tp1 (list (- x 1.06) (+ y (* i jj))))
	(setq txt1 "xxx")
	(command "_.text" "s" "style1" "ml" tp1 0.13 0 txt1)
	(setq i (1+ i))
      )
;;;endprogn
    )
;;;end if

    (if	(and ldyt (= (nth 16 gcwzb) "1"))
      (progn
	(setq tp2 (list (- x 0.4) (+ y (* i jj))))
	(if (findfile "c:/gees2000/岩土花纹/扰动样.dwg")
	  (command "_.insert"
		   "c:/gees2000/岩土花纹/扰动样.dwg"
		   tp2			1
		   1			""
		  )
	)
	(setq tp1 (list (- x 1.06) (+ y (* i jj))))
	(setq txt1 "xx(扰)")
	(command "_.text" "s" "style1" "ml" tp1 0.13 0 txt1)
	(setq i (1+ i))
      )
;;;endprogn
    )


    (if	(and yzyt (= (nth 15 gcwzb) "1"))
      (progn
	(setq tp2 (list (- x 0.4) (+ y (* i jj))))
	(if (findfile "c:/gees2000/岩土花纹/原状样.dwg")
	  (command "_.insert"
		   "c:/gees2000/岩土花纹/原状样.dwg"
		   tp2			1
		   1			""
		  )
	)
	(setq tp1 (list (- x 1) (+ y (* i jj))))
	(setq txt1 "xxxx")
	(command "_.text" "s" "style1" "ml" tp1 0.13 0 txt1)
	(setq i (1+ i))
      )
;;;endprogn
    )
;;;end if

    (setq tp1 (list (- x 0.65) (+ y (* i jj))))
    (setq txt1 "  19(-3)")
    (command "_.text" "s" "style1" "m" tp1 0.13 0 txt1)
    (setq tp1 (list (- x 1) (+ y (* i jj) 0.2)))
    (setq tp2 (list (- x 1) (+ y (* i jj) -0.2)))
    (command "_.pline" tp1 "w" 0.013 "" tp2 "")
    (setq tp1 (list (- x 0.9) (+ y (* i jj) 0.2)))
    (setq tp2 (list (- x 0.9) (+ y (* i jj) -0.2)))
    (command "_.pline" tp1 "w" 0.013 "" tp2 "")
    (setq tp1 (list (- x 0.9) (+ y (* i jj) -0.1)))
    (setq tp2 (list (- x 0.3) (+ y (* i jj) -0.1)))
    (command "_.pline" tp1 "w" 0.013 "" tp2 "")

















;;;;;;以下部份为岩土花纹自动填充
;;;;;;以下部份为岩土花纹自动填充
;;;;;;以下部份为岩土花纹自动填充
    (setq x (+ (car p1) 1)
	  y (cadr p1)
    )
    (setq point (list x y))
    (setq p00 (list (- 23.7 (car point)) (- 22 (cadr point))))


    (setq i11 0
	  ks1 (- jj)
    )
    (repeat (length b)			;repeat00000000000000000000000000000000000000000000
      (setq ks1 (+ ks1 jj))
      (setq yxms (nth i11 b))
      (setq i11 (1+ i11))
      (setq ks2 (+ ks1 0.45))
      (apply 'huawentc3 (list bzyxb yxms ks1 ks2))
    )					;end repeat0000000000000000000000000000000000000000000000000
  )
;;;end defun tlfun()







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

  (setq
    filename2 (nth 0 (apply 'readfile1 (list "c:/Gees2000/gcwz.txt")))
  )
  (setq listname2 "**pmt")
  (setq pmt (apply 'readfile (list filename2 listname2)))


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



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



  (setq	i 0
	j 0
  )
  (while (and (< j pmh) (< i (length pmt)))
    (setq ip0 i)
    (if	(= (nth i pmt) "---pmt")
      (setq j (1+ j))
    )
    (setq i (1+ i))
  )					;end whille

  (setq	subpmt nil
	zhb nil
  )
  (if (< ip0 (1- (length pmt)))
    (progn				;progn0
      (setq ip0 (1+ ip0))
      (while (/= (nth ip0 pmt) "---pmt") ;while0
	(setq subpmt (append subpmt (list (nth ip0 pmt))))
	(setq ip0 (1+ ip0))
	(setq abc (nth ip0 pmt))
      )					;end while0
    )					;end progn0
  )
  ;;end if



  (if (/= subpmt nil)
;;;;;;;if000000000000000000000000000000000000000
    (progn
;;;;;;progn0000000000000000000000000000000000000000000000000


      (setq ksmax -1000)
      (setq kgmax -1000)
      (setq kjsum 0)
      (setq blh (nth 1 subpmt))
      (setq blv (nth 2 subpmt))
      (setq psl	nil
	    pdl	nil
	    sw	nil
      )

      (setq i00	0
	    pmyxb nil
	    pmfchb nil
	    pmcyfhb nil
	    pmdb nil
	    yzyt nil
	    ldyt nil
	    yyt	nil
	    bgt	nil
	    zet	nil
	    swt	nil
	    fcht t
	    lczhb nil
	    lczht nil
      )
      (while (< i00 (- (length subpmt) 3)) ;while1
	(setq i00 (+ 3 i00))
	(setq x (/ (atof (nth (+ i00 1) subpmt)) (/ (atof blh) 100)))
	(setq y (/ (atof (nth (+ i00 2) subpmt)) (/ (atof blv) 100)))
	(if (< kgmax y)
	  (setq kgmax y)
	)				;end if
	(setq kjsum (+ kjsum x))
	(setq point (list kjsum y))
	(setq pdl (append pdl (list point)))
	(setq listname3 (strcat "**" (nth i00 subpmt)))
	(setq zk (apply 'readfile (list filename3 listname3)))
	(setq ks2 0)
	(apply 'pmzzt (list zk bzyxb point blv))
	(setq pmyxb (append pmyxb (list dkyxb)))
	(setq pmfchb (append pmfchb (list fchb)))
	(setq pmcyfhb (append pmcyfhb (list cyfhb)))
	(setq dkdb (append (list point) dkdb))
	(setq pmdb (append pmdb (list dkdb)))
	(if (< ksmax (- ks2 y))
	  (setq ksmax (- ks2 y))
	)
	(if (/= (car sw) 10000)
	  (setq psl (append psl (list sw)))
	  (setq psl (append psl (list "干孔")))
	)
      )					;end while1


      (setq q1 0)
      (repeat (length pmfchb)
	(setq d1 (nth q1 pmfchb))
	(setq q1 (1+ q1)
	      q2 0
	)
	(repeat	(length d1)
	  (setq	d2 (nth q2 d1)
		q2 (1+ q2)
	  )
	  (if (= d2 "")
	    (setq fcht nil)
	  )
	)
	;;endrepeat 
      )
;;;end repeat






      (setq lc 0)
      (repeat (length lczhb)
	(setq lcs (nth lc lczhb))
	(if (and (/= lcs "")
		 (/= lcs " ")
		 (/= lcs "  ")
		 (/= lcs "   ")
		 (/= lcs "    ")
	    )
	  (setq lczht t)
	)
;;;end if
	(setq lc (1+ lc))
      )
      ;;end repeat


















      (setq p0 (list (/ kjsum 2) (/ (- kgmax ksmax) 2)))
      (if (< kjsum 26)
	(setq x1 (- (car p0) 17)
	      x2 (+ (car p0) 20)
	)
	(setq x1 -6
	      x2 (+ 8 kjsum)
	)
      )
      (if (= (nth 19 gcwzb) "0")
	(if (< kjsum 30)
	  (setq	x1 (- (car p0) 19)
		x2 (+ (car p0) 18)
	  )
	  (setq	x1 -6
		x2 (+ 4 kjsum)
	  )
	)
      )
      (if (< (+ kgmax ksmax) 18)
	(setq y1 (- (cadr p0) 12)
	      y2 (+ (cadr p0) 14)
	)
	(setq y1 (- -4 ksmax)
	      y2 (+ kgmax 4)
	)
      )
      (setq p1 (list x1 y1)
	    p2 (list x2 y2)
      )
      (setq p001 p1
	    p002 p2
      )
      (command "_.rectang" "w" 0.13 p1 p2)

      (setq tp1 (list (car p0) (+ kgmax (/ (- (cadr p2) kgmax) 2) 1)))
      (setq tp2	(list (- (car tp1) 1.6) (- (cadr tp1) 1.2))
	    tp3	(list (car tp1) (+ (cadr tp2) 0.2))
	    tp4	(list (car tp1) (- (cadr tp2) 0.2))
      )
      (cond
	((= (nth 10 gcwzb) "1")
	 (setq txt1 (strcat (nth 0 subpmt)
			    "—"
			    (nth 0 subpmt)
			    "′"
			    " 工 程 地 质 剖 面 图"
		    )
	 )
	)
	((= (nth 10 gcwzb) "2")
	 (setq txt1 (strcat (nth 0 subpmt) " 工 程 地 质 剖 面 图"))
	)
	((= (nth 10 gcwzb) "3")
	 (setq txt1 (strcat (nth 0 subpmt)
			    "—"
			    (nth 0 subpmt)
			    "′"
			    "工 程 地 质 横 剖 面 图"
		    )
	 )
	)
	((= (nth 10 gcwzb) "4")
	 (setq txt1 (strcat (nth 0 subpmt) "工 程 地 质 横 剖 面 图"))
	)
	((= (nth 10 gcwzb) "5")
	 (setq txt1 (strcat (nth 0 subpmt)
			    "—"
			    (nth 0 subpmt)
			    "′"
			    "工 程 地 质 纵 剖 面 图"
		    )
	 )
	)
	((= (nth 10 gcwzb) "6")
	 (setq txt1 (strcat (nth 0 subpmt) "工 程 地 质 纵 剖 面 图"))
	)
	((= (nth 10 gcwzb) "7")
	 (setq txt1 (strcat (nth 0 subpmt) ""))
	)
      )
      ;;endcond
      (setq txt2 "比 例"
	    txt3 (strcat "水 平  1:" blh)
	    txt4 (strcat "垂 直  1:" blv)
      )
      (command "_.text" "s" "style4" "m" tp1 0.6 0 txt1)
      (command "_.text" "s" "style3" "ml" tp2 0.3 0 txt2)
      (command "_.text" "s" "style3" "ml" tp3 0.23 0 txt3)
      (command "_.text" "s" "style3" "ml" tp4 0.23 0 txt4)
      (if (= (nth 19 gcwzb) "1")
	(setq p10 (list (+ 0.2 (car p1)) (+ (cadr p1) 1))
	      p20 (list (- (car p2) 7) (+ (cadr p1) 2.6))
	)
	(setq p10 (list (+ 0.2 (car p1)) (+ (cadr p1) 1))
	      p20 (list (- (car p2) 1) (+ (cadr p1) 2.6))
	)
      )
      (command "_.rectang" "w" 0.013 p10 p20)
      (setq p30	(list (car p10) (+ 0.8 (cadr p10)))
	    p40	(list (car p20) (+ 0.8 (cadr p10)))
      )
      (command "_.pline" p30 "w" 0.013 "" p40 "")
      (setq p30	(list (+ 2 (car p10)) (cadr p10))
	    p40	(list (+ 2 (car p10)) (+ 1.6 (cadr p10)))
      )
      (command "_.pline" p30 "w" 0.013 "" p40 "")
      (setq tp1	(list (+ 1 (car p10)) (+ 1.2 (cadr p10)))
	    tp2	(list (+ 1 (car p10)) (+ 0.4 (cadr p10)))
      )
      (if (= lczht nil)
	(setq txt1 "孔口高程(m)"
	      txt2 "孔  距 (m)"
	)
	(setq txt1 "地面标高(m)"
	      txt2 "里程桩号"
	)
      )

      (command "_.text" "s" "style1" "m" tp1 0.23 0 txt1)
      (command "_.text" "s" "style1" "m" tp2 0.23 0 txt2)
      (setq p10	p1
	    p20	(list (+ (car p1) 37) (+ (cadr p1) 0.7))
      )
      (command "_.rectang" "w" 0.013 p10 p20)

      (setq tp1 (list (+ (car p10) 4.25) (+ (cadr p10) 0.35)))
      (setq p10	(list (+ (car p10) 8.5) (cadr p10))
	    p20	(list (car p10) (+ 0.7 (cadr p10)))
      )
      (command "_.pline" p10 "w" 0.013 "" p20 "")
      (setq txt1 (nth 0 zhb))
      (setq gcmc txt1)
      (setq wtdw (nth 1 gcgkb))
      (setq txt1 (strcat wtdw "  " txt1))
      (if (< (strlen txt1) 53)
	(command "_.text" "s" "style1" "m" tp1 0.23 0 txt1)
	(progn
	  (setq tp01 (list (- (car tp1) 4.1) (- (cadr tp1) 0.115)))
	  (setq tp02 (list (+ (car tp1) 4.1) (- (cadr tp1) 0.115)))
	  (command "_.text" "s" "style1" "j" "f" tp01 tp02 0.23 txt1)
	)
	;;endprogn
      )
;;;;;endif
      (setq tp1 (list (+ (car p10) 2.75) (+ (cadr p10) 0.35)))
      (setq p10	(list (+ (car p10) 5.5) (cadr p10))
	    p20	(list (car p10) (+ 0.7 (cadr p10)))
      )
      (command "_.pline" p10 "w" 0.013 "" p20 "")
      (cond
	((= (nth 10 gcwzb) "1")
	 (setq txt1 (strcat (nth 0 subpmt)
			    "—"
			    (nth 0 subpmt)
			    "′"
			    " 工 程 地 质 剖 面 图"
		    )
	 )
	)
	((= (nth 10 gcwzb) "2")
	 (setq txt1 (strcat (nth 0 subpmt) " 工 程 地 质 剖 面 图"))
	)
	((= (nth 10 gcwzb) "3")
	 (setq txt1 (strcat (nth 0 subpmt)
			    "—"
			    (nth 0 subpmt)
			    "′"
			    "工 程 地 质 横 剖 面 图"
		    )
	 )
	)
	((= (nth 10 gcwzb) "4")
	 (setq txt1 (strcat (nth 0 subpmt) "工 程 地 质 横 剖 面 图"))
	)
	((= (nth 10 gcwzb) "5")
	 (setq txt1 (strcat (nth 0 subpmt)
			    "—"
			    (nth 0 subpmt)
			    "′"
			    "工 程 地 质 纵 剖 面 图"
		    )
	 )
	)
	((= (nth 10 gcwzb) "6")
	 (setq txt1 (strcat (nth 0 subpmt) "工 程 地 质 纵 剖 面 图"))
	)
	((= (nth 10 gcwzb) "7")
	 (setq txt1 (strcat (nth 0 subpmt) ""))
	)
      )
      ;;endcond
      (command "_.text" "s" "style1" "m" tp1 0.23 0 txt1)
      (setq tjmc txt1)
      (setq tp1 (list (+ (car p10) 0.85) (+ (cadr p10) 0.35)))
      (setq p10	(list (+ (car p10) 1.7) (cadr p10))
	    p20	(list (car p10) (+ 0.7 (cadr p10)))
      )
      (command "_.pline" p10 "w" 0.013 "" p20 "")
      (setq txt1 "编  制")
      (command "_.text" "s" "style1" "m" tp1 0.23 0 txt1)
      (setq tp111 (list (+ (car p10) 1.4) (+ (cadr p10) 0.35)))


      (setq tp1 (list (+ (car p10) 0.85) (+ (cadr p10) 0.35)))
      (setq p10	(list (+ (car p10) 2.8) (cadr p10))
	    p20	(list (car p10) (+ 0.7 (cadr p10)))
      )
      (command "_.pline" p10 "w" 0.013 "" p20 "")

      (setq tp1 (list (+ (car p10) 0.85) (+ (cadr p10) 0.35)))
      (setq p10	(list (+ (car p10) 1.7) (cadr p10))
	    p20	(list (car p10) (+ 0.7 (cadr p10)))
      )
      (command "_.pline" p10 "w" 0.013 "" p20 "")
      (setq txt1 "复  核")
      (command "_.text" "s" "style1" "m" tp1 0.23 0 txt1)

      (setq tp1 (list (+ (car p10) 0.85) (+ (cadr p10) 0.35)))
      (setq p10	(list (+ (car p10) 2.8) (cadr p10))
	    p20	(list (car p10) (+ 0.7 (cadr p10)))
      )
      (command "_.pline" p10 "w" 0.013 "" p20 "")


      (setq tp1 (list (+ (car p10) 0.85) (+ (cadr p10) 0.35)))
      (setq p10	(list (+ (car p10) 1.7) (cadr p10))
	    p20	(list (car p10) (+ 0.7 (cadr p10)))
      )
      (command "_.pline" p10 "w" 0.013 "" p20 "")
      (setq txt1 "审  核")
      (command "_.text" "s" "style1" "m" tp1 0.23 0 txt1)

      (setq tp1 (list (+ (car p10) 0.85) (+ (cadr p10) 0.35)))
      (setq p10	(list (+ (car p10) 2.8) (cadr p10))
	    p20	(list (car p10) (+ 0.7 (cadr p10)))
      )
      (command "_.pline" p10 "w" 0.013 "" p20 "")

      (setq tp1 (list (+ (car p10) 0.85) (+ (cadr p10) 0.35)))
      (setq p10	(list (+ (car p10) 1.7) (cadr p10))
	    p20	(list (car p10) (+ 0.7 (cadr p10)))
      )
      (command "_.pline" p10 "w" 0.013 "" p20 "")
      (setq txt1 "图 表 号")
      (command "_.text" "s" "style1" "m" tp1 0.23 0 txt1)

      (setq tp1 (list (+ (car tp1) 2.25) (cadr tp1)))
      (setq txt1 (nth 14 gcgkb))
      (command "_.text" "s" "style1" "m" tp1 0.23 0 txt1)



      (setq tp1 (list (+ (car p10) 0.85) (+ (cadr p10) 0.35)))
      (setq p10	(list (+ (car p10) 2.8) (cadr p10))
	    p20	(list (car p10) (+ 0.7 (cadr p10)))
      )
      (command "_.pline" p10 "w" 0.013 "" p20 "")

      (setq tp1 (list (+ (car p10) 2.5) (+ (cadr p10) 0.35)))
      (setq txt1 (strcat "第" (itoa pmh) "页" " " "共" (itoa zym) "页"))
      (command "_.text" "s" "style1" "m" tp1 0.23 0 txt1)

      (setq tjymh txt1)


      (setq i 4
	    j 0
      )
      (while (< i (- (length subpmt) 3))
	(setq i (+ 3 i))
	(if (= lczht nil)
	  (progn
	    (setq p10 (list (car (nth j pdl)) (+ (cadr p1) 1)))
	    (setq p20 (list (car (nth j pdl)) (+ (cadr p1) 2)))
	    (setq p30 (list (car (nth j pdl)) (+ (cadr p1) 2.4)))
	    (setq p40 (list (car (nth j pdl)) (+ (cadr p1) 2.6)))
	    (command "_.pline" p10 "w" 0.013 "" p20 "")
	    (command "_.pline" p30 "w" 0.013 "" p40 "")
	  )
;;;endprogn
	  (progn
	    (setq p10 (list (car (nth j pdl)) (+ (cadr p1) 1)))
	    (setq p20 (list (car (nth j pdl)) (+ (cadr p1) 1.2)))
	    (setq p50 (list (car (nth j pdl)) (+ (cadr p1) 1.6)))
	    (setq p60 (list (car (nth j pdl)) (+ (cadr p1) 2)))
	    (setq p30 (list (car (nth j pdl)) (+ (cadr p1) 2.4)))
	    (setq p40 (list (car (nth j pdl)) (+ (cadr p1) 2.6)))
	    (command "_.pline" p10 "w" 0.013 "" p20 "")
	    (command "_.pline" p30 "w" 0.013 "" p40 "")
	    (command "_.pline" p50 "w" 0.013 "" p60 "")
	  )
;;;endprogn
	)
;;;endif

	(setq txt3 (nth j lczhb))
	(setq tp3 (list (car (nth j pdl)) (+ (cadr p1) 1.4)))
	(setq tp1 (list (car (nth j pdl)) (+ (cadr p1) 2.2)))
	(setq
	  tp2
	   (list (+ (car (nth j pdl))
		    (/ (/ (atof (nth i subpmt)) (/ (atof blh) 100)) 2)
		 )
		 (+ (cadr p1) 1.4)
	   )
	)
	(setq j (1+ j))
	(setq txt1 (nth (- i 2) subpmt))
	(setq txt2 (nth i subpmt))
	(if (= lczht t)
	  (command "_.text" "s" "style1" "m" tp3 0.23 0 txt3)
	)
	(command "_.text" "s" "style1" "m" tp1 0.23 0 txt1)
	(command "_.text" "s" "style1" "m" tp2 0.23 0 txt2)
      )					;end while
      (if (= lczht nil)
	(progn
	  (setq p10 (list (car (nth j pdl)) (+ (cadr p1) 1)))
	  (setq p20 (list (car (nth j pdl)) (+ (cadr p1) 2)))
	  (setq p30 (list (car (nth j pdl)) (+ (cadr p1) 2.4)))
	  (setq p40 (list (car (nth j pdl)) (+ (cadr p1) 2.6)))
	  (command "_.pline" p10 "w" 0.013 "" p20 "")
	  (command "_.pline" p30 "w" 0.013 "" p40 "")
	)
;;;endprogn
	(progn
	  (setq p10 (list (car (nth j pdl)) (+ (cadr p1) 1)))
	  (setq p20 (list (car (nth j pdl)) (+ (cadr p1) 1.2)))
	  (setq p50 (list (car (nth j pdl)) (+ (cadr p1) 1.6)))
	  (setq p60 (list (car (nth j pdl)) (+ (cadr p1) 2)))
	  (setq p30 (list (car (nth j pdl)) (+ (cadr p1) 2.4)))
	  (setq p40 (list (car (nth j pdl)) (+ (cadr p1) 2.6)))
	  (command "_.pline" p10 "w" 0.013 "" p20 "")
	  (command "_.pline" p30 "w" 0.013 "" p40 "")
	  (command "_.pline" p50 "w" 0.013 "" p60 "")
	)
;;;endprogn
      )
;;;endif
      (setq tp1 (list (car (nth j pdl)) (+ (cadr p1) 2.2)))
      (setq txt1 (nth (+ i 1) subpmt))
      (command "_.text" "s" "style1" "m" tp1 0.23 0 txt1)
      (setq txt3 (nth j lczhb))
      (setq tp3 (list (car (nth j pdl)) (+ (cadr p1) 1.4)))
      (if (= lczht t)
	(command "_.text" "s" "style1" "m" tp3 0.23 0 txt3)
      )









      (setq a (1+ (fix kgmax))
	    b (- -1 (fix ksmax))
      )
      (if (< ksmax 0)
	(setq b (1+ b))
      )

      (if (<= (+ b ksmax) -0.5)
	(setq b (+ b 0.5))
      )
      (setq p10	(list (+ (car p1) 1.5) a)
	    p20	(list (+ (car p1) 1.65) b)
      )
      (command "_.rectang" "w" 0.013 p10 p20)
      (setq tp1 (list (car p20) (+ (cadr p10) 0.3)))
      (command "_.text" "s" "style1" "m" tp1 0.23 0 "高程(m)")
      (setq j t)
      (while (> a b)
	(setq j (not j))
	(setq tp1  (list (- (car p10) 0.1) a)
	      txt1 (rtos (* a (/ (atof blv) 100)) 2 1)
	)
	(command "_.text" "s" "style1" "mr" tp1 0.23 0 txt1)
	(setq p11 (list (+ (car p10) 0.075) a))
	(setq p12 (list (+ (car p10) 0.075) (+ a 2)))
	(if j
	  (command "_.pline" p11 "w" 0.15 "" p12 "")
	)
	(setq a (- a 2))
      )					;end while
      (setq j (not j))
      (setq p11 (list (+ (car p10) 0.075) (+ a 2)))
      (setq p12 (list (+ (car p10) 0.075) b))
      (if j
	(command "_.pline" p11 "w" 0.15 "" p12 "")
      )
      (setq tp1	 (list (- (car p10) 0.1) b)
	    txt1 (rtos (* b (/ (atof blv) 100)) 2 1)
      )
      (command "_.text" "s" "style1" "mr" tp1 0.23 0 txt1)









      (command "_.zoom" "e")


      (if (= (nth 13 gcwzb) "1")
	(if (= (nth 29 gcwzb) "1")
	  (apply 'pmlx (list pmfchb pmdb))
	  (apply 'pmlxline (list pmfchb pmdb))
	)
      )
      ;;end if





      (if (= (nth 12 gcwzb) "1")
	(if (= (nth 29 gcwzb) "1")
	  (progn
	    (command "_.color" 240)
	    (setq p1 (list (- (car (car pdl)) 1) (cadr (car pdl))))
	    (setq p2 (list (+ (car (last pdl)) 1) (cadr (last pdl))))
	    (setq pdl (append (list p1) pdl (list p2)))
	    (setq i 0)
	    (command "_.spline")
	    (repeat (length pdl)
	      (command (nth i pdl))
	      (setq i (1+ i))
	    )
	    ;;end repeat
	    (command "" "" "")
	  )
;;;endprogn
	  (progn
	    (command "_.color" 240)
	    (setq p1 (list (- (car (car pdl)) 1) (cadr (car pdl))))
	    (setq p2 (list (+ (car (last pdl)) 1) (cadr (last pdl))))
	    (setq pdl (append (list p1) pdl (list p2)))
	    (setq i 0)
	    (command "_.line")
	    (repeat (length pdl)
	      (command (nth i pdl))
	      (setq i (1+ i))
	    )
	    ;;end repeat
	    (command "" "" "")
	    (command)
	  )
;;;endprogn	
	)
      )
;;;endif


      (setq i 0)
      (setq pslzb ()
	    pslb ()
      )
      (repeat (length psl)
	(if (/= (nth i psl) "干孔")
	  (setq pslb (append pslb (list (nth i psl))))
	)

	(if (and (> i 0)
		 (/= (nth i psl) "干孔")
		 (= (nth (1- i) psl) "干孔")
	    )
	  (progn
	    (setq p1 (list (/ (+ (car (last (nth i pmdb)))
				 (car (last (nth (1- i) pmdb)))
			      )
			      2
			   )
			   (cadr (last (nth (1- i) pmdb)))
		     )
	    )
	    (setq pslb (append (list p1) pslb))
	  )
	)
;;;endif

	(if (and (< i (1- (length psl)))
		 (/= (nth i psl) "干孔")
		 (= (nth (1+ i) psl) "干孔")
	    )
	  (progn
	    (setq p1 (list (/ (+ (car (last (nth i pmdb)))
				 (car (last (nth (1+ i) pmdb)))
			      )
			      2
			   )
			   (cadr (last (nth (1+ i) pmdb)))
		     )
	    )
	    (setq pslb (append pslb (list p1)))
	    (setq pslzb (append pslzb (list pslb)))
	    (setq pslb ())
	  )
	)
;;;endif
	(setq i (1+ i))
      )
;;;end repeat
      (setq pslzb (append pslzb (list pslb)))

      (if (= (nth 14 gcwzb) "1")
	(progn
	  (command "_.color" 150)
	  (command "_.linetype" "l" "dashed" "" "")
	  (command)
	  (command "_.linetype" "s" "dashed" "")
	  (if (= cad "2000")
	    (command "_.ltscale" 0.02)
	    (command "_.ltscale" 1)
	  )
	  (setq j 0)
	  (repeat (length pslzb)
	    (setq psl (nth j pslzb))
	    (setq i 0)
	    (if	(>= (length psl) 2)
	      (progn
		(if (= (nth 29 gcwzb) "1")
		  (command "_.spline")
		  (command "_.line")
		)
		;;end if
		(repeat	(length psl)
		  (command (nth i psl))
		  (setq i (1+ i))
		)
		;;end repeat
		(command "" "" "")
		(command)
	      )
	    )
;;;end if
	    (setq j (1+ j))
	  )
;;;end repeat




	  (command "_.color" "bylayer")
	  (command "_.linetype" "s" "bylayer" "")
	  (if (> (length psl) 0)
	    (setq swt t)
	  )
	)
;;;endprogn
      )
;;;endif





      (if (and (= fcht t) (= (nth 8 gcwzb) "1"))
	(apply 'writefch (list pmfchb pmdb))
      )




      (defun yxfcbfun (b h a)

	(defun gzbfun (b11 h11 i11)
	  (setq	g11 b11
		f11 nil
	  )
	  (repeat i11
	    (setq f11 (append f11 (list (car g11)))
		  g11 (cdr g11)
	    )
	  )
	  (setq b11 (append f11 (list h11) g11))
	)				;end defun

	(setq m11 0)
	(setq i11 0)

	(repeat	(length a)		;repeat000000000000000000000000000000000000000000000000000000000000000000000000000000
	  (setq	c11  (nth m11 a)
		m11  (1+ m11)
		i11p nil
	  )
	  (if (/= (member h c11) nil)
;;;;if0000000000000000000000000000000000000000000
	    (progn
;;;progn00000000000000000000000000000000000000000  
	      (setq i0 0
		    t1 t
		    t2 nil
		    t3 nil
		    w1 nil
		    w2 nil
		    w3 nil
	      )
	      (while (< i0 (length c11))
		(if (and (= h (nth i0 c11)) t1)
		  (setq	w1 i0
			t1 nil
			t2 t
		  )
		)
		(if (and (= h (nth i0 c11)) t2)
		  (setq	w2 i0
			t2 nil
			t3 t
		  )
		)
		(if (and (= h (nth i0 c11)) t3)
		  (setq	w3 i0
			t3 nil
		  )
		)
		(setq i0 (1+ i0))
	      )				;endwhile
	      (if t2
		(setq t3 t)
	      )

	      (if (not t1)		;if111
		(progn
		  (if (= w1 0)
		    (setq yx1 "")
		    (setq yx1 (nth (1- w1) c11))
		  )
		  (if (= w1 (1- (length c11)))
		    (setq yx2 "")
		    (setq yx2 (nth (1+ w1) c11))
		  )
		  (setq yxp1 (strcat yx1 yx2))
		  (setq	b22 (append (list "") b)
			b22 (append b22 (list ""))
		  )
		  (setq	i22 0
			t22 t
		  )
		  (while (and t22 (< i22 (1- (length b22))))
					;while222222
		    (setq
		      yxp2 (strcat (nth i22 b22) (nth (1+ i22) b22))
		    )
		    (setq i22 (1+ i22))
		    (if	(= yxp1 yxp2)
		      (setq t22	 nil
			    i11p (1- i22)
		      )
		    )
		  )			;end while2222
		  (if (= i11p nil)
;;;if333333333
		    (progn
		      (if (= h "素填土")
			(setq i11p 0)
		      )
		      (if (= h "填筑土")
			(if (/= (nth 1 b22) "素填土")
			  (setq i11p 0)
			  (setq i11p 1)
			)
		      )
		      (if (= h "杂填土")
			(if
			  (and (/= (nth 1 b22) "素填土")
			       (/= (nth 1 b22) "填筑土")
			  )
			   (setq i11p 0)
			   (setq i11p 1)
			)
		      )
		      (if (or (= h "耕植土") (= h "种植土"))
			(if (or	(/= (nth 1 b22) "素填土")
				(/= (nth 1 b22) "填筑土")
				(/= (nth 1 b22) "杂填土")
			    )
			  (setq i11p 0)
			  (setq i11p 1)
			)
		      )
		    )			;end progn
		  )			;end if3333333

		  (if (= i11p nil)
;;;if4444444444
		    (progn
		      (if (= w1 0)
			(setq yx1 "00")
			(setq yx1 (nth (1- w1) c11))
		      )
		      (setq i22	0
			    t22	t
		      )
		      (while (and t22 (< i22 (1- (length b22))))
					;while222222
			(setq yxp2 (nth i22 b22))
			(setq i22 (1+ i22))
			(if (= yx1 yxp2)
			  (setq	t22  nil
				i11p (1- i22)
			  )
			)
		      )			;end while2222
		    )			;end progn
		  )			;end if444444444444
		)
;;;;end progn
	      )
;;;;endif111111111111111111111
	    )
;;;;end progn00000000000000000000000000
	  )
;;;;end if000000000000000000000000000000000000000000000000
	  (if (and (/= i11p nil) (< i11 i11p))
	    (setq i11 i11p)
	  )
	)
;;;;;end repeat000000000000000000000000000000000000000000000000000000

	(if (and (not t1) (= i11p nil))
;;;if55555555555555555
	  (progn
	    (if	(= w1 (1- (length c11)))
	      (setq yx2 "00")
	      (setq yx2 (nth (1+ w1) c11))
	    )
	    (setq i22 0
		  t22 t
	    )
	    (while (and t22 (< i22 (1- (length b22)))) ;while222222
	      (setq yxp2 (nth i22 b22))
	      (setq i22 (1+ i22))
	      (if (= yx2 yxp2)
		(setq t22  nil
		      i11p (1- i22)
		)
	      )
	    )				;end while2222
	  )				;end progn
	)				;end if5555555555555555555

	(if (= i11p nil)
;;;if6666666666666
	  (progn
	    (if	(= w1 0)
	      (setq i11p 0)
	    )
	    (if	(= w1 (1- (length c11)))
	      (setq i11p (1- (length b)))
	    )
	  )				;end progn
	)				;end if666666666666666666666


	(setq b (apply 'gzbfun (list b h i11)))

      )
;;;;;;;end defun yxfcbfun

      (setq a pmyxb)

      (setq b nil
	    c nil
	    d a
      )
      (repeat (length a)
	(setq i	0
	      b	(nth 0 d)
	      e	nil
	)
	(while (< i (length d))
	  (if (< (length b) (length (nth i d)))
	    (setq b (nth i d))
	  )
	  (setq i (1+ i))
	)
;;;end while
	(setq c (append c (list b)))
	(setq i 0)
	(while (< i (length d))
	  (if (/= b (nth i d))
	    (setq e (append e (list (nth i d))))
	  )
	  (setq i (1+ i))
	)
;;;end while
	(setq d e)
      )
;;;end repeat
      (setq a c)



      (setq b nil)
      (setq i 0)
      (repeat (length a)
	(if (< (length b) (length (nth i a)))
	  (setq b (nth i a))
	)
	(setq i (1+ i))
      )					;end repeat



      (setq i 0)
      (while (< i (length a))		;while0000000000000000
	(setq c	(nth i a)
	      i	(1+ i)
	      j	0
	)
	(repeat	(length c)		;repeat11111111111111
	  (setq	d (nth j c)
		j (1+ j)
	  )
	  (if (/= (member d b))
	    ;;ifm
	    (progn
;;;;3333333333333333
	      (setq ii0	0
		    ttt	t
	      )
	      (while (and ttt (< ii0 (length a)))
;;;;;while ii0
		(setq cc0 (nth ii0 a)
		      ii0 (1+ ii0)
		)
		(if (/= (member d cc0) nil)
;;;;;;;if d is member cc0
		  (progn
;;;;;;;;progn3333333333
		    (setq ii 0)
		    (while (/= (nth ii cc0) d) (setq ii (1+ ii)))
		    (if	(/= ii 0)	;if /= ii 0
		      ;;ifd1
		      (progn (setq d1 (nth (1- ii) cc0))
			     (if (= (member d1 b) nil)
			       (setq b	 (apply 'yxfcbfun (list b d1 a))
				     ttt nil
			       )
			     )
		      )
		    )
;;;end if /= ii 0
		  )			;end progn333333333333333333
		)
;;;end if d is member cc0
	      )				;endwhile ii0
	      (if (= (member d b) nil)
		(setq b (apply 'yxfcbfun (list b d a)))
	      )
	    )
;;;;;;progn333333333333
	  )
;;;end ifm
	)				;repeat11111111111111111111111111111
      )					;end while 00000000000000000000000000000000

      (setq j 0)
      (setq c (list (nth 0 b)))
      (while (< j (length b))
	(setq bb (nth j b))
	(if (= (member bb c) nil)
	  (setq c (append c (list bb)))
	)
	;;end if
	(setq j (1+ j))
      )
;;;end repeat


      (setq b c)




      (if (= (nth 19 gcwzb) "1")
	(apply 'tlfun ())
      )
      ;;end if

      (setq gcml (nth 30 gcwzb))
      (setq txt1 (strcat gcml gcmc "-" tjmc "(" tjymh ")"))
      (setq txt1
	     (strcat
	       "c:/Gees2000/福建省第四地质大队岩土工程勘察专家系统/gcrtf/"
	       tjmc
	       "("
	       tjymh
	       ")"
	      )
      )

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





    )
;;;;;;;;;end progn000000000000000
    (progn
;;;progn11111111111111111
      (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" "style4" "m" tp1 2.8 0 txt1)
      (command "_.color" "bylayer")
    )
;;;end progn1111111111111111
  )					;end if000000000000000000000000000000000000




)
;;;;;;;;;;;;;;;;;;;;end defun pmtprint()******************************************************

;;;;;;;;;;;;;;;;;;;;end defun pmtprint()*****************************************************

;;;;;;;;;;;;;;;;;;;;end defun pmtprint()*****************************************************


;;;;;;;;;;;;;;;;;;;;end defun pmtprint*****************************************************
