




;;;;;;替换岩土名称函数
;;;;;;替换岩土名称函数
;;;;;;替换岩土名称函数
;;;;;;替换岩土名称函数
;;;;;;替换岩土名称函数
(defun tfmc (b)
  (setq i1 0)
  (while (< i1 (strlen b))
    (setq i1 (1+ i1))
    (if	(/= (substr b i1 1) nil)
      (progn
;;;;begin progn
	(if (= (substr b i1 2) "（")
	  (progn
	    (setq d1 (substr b 1 (1- i1)))
	    (setq d2 (substr b (+ i1 2)))
	    (setq b (strcat d1 "《" d2))
	  )
	)

	(if (= (substr b i1 2) "）")
	  (progn
	    (setq d1 (substr b 1 (1- i1)))
	    (setq d2 (substr b (+ i1 2)))
	    (setq b (strcat d1 "》" d2))
	  )
	)


	(if (= (substr b i1 1) "(")
	  (progn
	    (setq d1 (substr b 1 (1- i1)))
	    (setq d2 (substr b (+ i1 1)))
	    (setq b (strcat d1 "《" d2))
	  )
	)


	(if (= (substr b i1 1) ")")
	  (progn
	    (setq d1 (substr b 1 (1- i1)))
	    (setq d2 (substr b (+ i1 1)))
	    (setq b (strcat d1 "》" d2))
	  )
	)

      )
;;;end progn


    )					;endif

  )					;end while(and (< i1 16)j)
  (setq d b)
)
;;;;end defun

;;;;;;替换岩土名称函数
;;;;;;替换岩土名称函数
;;;;;;替换岩土名称函数
;;;;;;替换岩土名称函数
;;;;;;替换岩土名称函数
;;;;;;替换岩土名称函数




;;;;;;替换岩土名称函数
;;;;;;替换岩土名称函数
;;;;;;替换岩土名称函数
;;;;;;替换岩土名称函数
;;;;;;替换岩土名称函数
(defun wtfmc (b)
  (setq i1 0)
  (while (< i1 (strlen b))
    (setq i1 (1+ i1))
    (if	(/= (substr b i1 1) nil)
      (progn
;;;;begin progn
	(if (= (substr b i1 2) "《")
	  (progn
	    (setq d1 (substr b 1 (1- i1)))
	    (setq d2 (substr b (+ i1 2)))
	    (setq b (strcat d1 "(" d2))
	  )
	)

	(if (= (substr b i1 2) "》")
	  (progn
	    (setq d1 (substr b 1 (1- i1)))
	    (setq d2 (substr b (+ i1 2)))
	    (setq b (strcat d1 ")" d2))
	  )
	)


      )
;;;end progn


    )					;endif

  )					;end while(and (< i1 16)j)
  (setq d b)
)
;;;;end defun


(defun cwtfmc (b)
  (setq i1 0)
  (while (< i1 (strlen b))
    (setq i1 (1+ i1))
    (if	(/= (substr b i1 1) nil)
      (progn
;;;;begin progn
	(if (= (substr b i1 2) "《")
	  (progn
	    (setq d1 (substr b 1 (1- i1)))
	    (setq d2 (substr b (+ i1 2)))
	    (setq b (strcat d1 "（" d2))
	  )
	)

	(if (= (substr b i1 2) "》")
	  (progn
	    (setq d1 (substr b 1 (1- i1)))
	    (setq d2 (substr b (+ i1 2)))
	    (setq b (strcat d1 "）" d2))
	  )
	)


      )
;;;end progn


    )					;endif

  )					;end while(and (< i1 16)j)
  (setq d b)
)
;;;;;;end defin cwtfcm()


;;;;;;替换岩土名称函数
;;;;;;替换岩土名称函数
;;;;;;替换岩土名称函数
;;;;;;替换岩土名称函数
;;;;;;替换岩土名称函数
;;;;;;替换岩土名称函数


(setq gcmc ""
      tjmc ""
      tjymh ""
)
(defun c:g ()

  (command "_.limits" "off")
  (command "_.ucsicon" "off")
  (command "_.color" 1)
;;;  (command "_.style" "style1" "楷体.ttf" "" "" "" "" "" "")
;;;  (command "_.style" "style11" "楷体.ttf" "" "" "" "" "" "")
  (command "_.style" "style1" "楷体_GB2312" "" "" "" "" "" "")
;;;  (command "_.style" "style11" "@SIMKAI.TTF" 0.23 "" "" "" "" "y")
  (command "_.style" "style3" "黑体" "" "" "" "" "" "")
  (command "_.style" "style4" "华文新魏" "" "" "" "" "" "")

  (command "_.point" "-10,-20")
  (command "_.point" "-10,20")
  (command "_.point" "50,20")
  (command "_.point" "50,-20")
  (command "_.zoom" "e")
  (setq a '("GEES" "岩" "土" "工" "程" "勘" "察"))
  (setq	i 0
	x -5
	y 12
  )
  (repeat (length a)
    (setq txt1 (nth i a)
	  i    (1+ i)
    )
    (setq x   (+ x 5)
	  tp1 (list x y)
    )
    (command "_.text" "s" "style3" "m" tp1 3.6 0 txt1)
    (setq j 0)
    (while (< j 15000) (setq j (1+ j)))
  )
  ;;end repeat

  (setq a '("工" "程" "勘" "察" "图" "件" "输" "出" "系" "统"))
  (setq	i 0
	x -10
	y 1
  )
  (repeat (length a)
    (setq txt1 (nth i a)
	  i    (1+ i)
    )
    (setq x   (+ x 5.5)
	  tp1 (list x y)
    )
    (command "_.text" "s" "style4" "m" tp1 5 0 txt1)
    (setq j 0)
    (while (< j 10000) (setq j (1+ j)))
  )
  ;;end repeat
  (command
    "_.saveas"
    ""
    "c:/Gees/岩土工程勘察专家系统CAD部份one by one"
    "y"
  )
  (command)
  (setq tp1 '(20 -8))
  (setq txt1 "CAD DEPARTMENT OF GEOTECHNICAL ENGINEERING ")
  (command "_.text" "s" "style3" "m" tp1 1.8 0 txt1)
  (setq tp1 '(20 -12))
  (setq txt1 "_INVESTIGATION & SURVEYING EXPERT SYSTEM")
  (command "_.text" "s" "style3" "m" tp1 2.2 0 txt1)
  (setq j 0)
  (while (< j 95000) (setq j (1+ j)))
  (command "_.erase" "c" "-1000,-1000" "1000,1000" "")




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

  (setq listname3 (strcat "**" (nth 1 zzt)))
  (setq zk1 (apply 'readfile (list filename3 listname3)))

  (setq	i1  0
	zhb nil
  )
  (if (= (nth i1 zk1) "---0")
    (progn				;progn0
      (setq i1 (1+ i1))
      (while (/= (substr (nth i1 zk1) 1 3) "---") ;while0
	(setq zhb (append zhb (list (nth i1 zk1))))
	(setq i1 (1+ i1))
	(setq abc (nth i1 zk1))
      )					;end while0
    )					;end progn0
  )					;end if---0

  (setq a (nth 0 zhb))


  (setq tp1 '(20 8))

  (command "_.text" "s" "style4" "m" tp1 3 0 a)

  (setq	a
	 '("绘制钻孔平面布置图：请输入pp(回车)"
	   "绘制钻孔柱状图：请输入页号，如z1(回车)、z2(回车)……"
	   "绘制工程地质剖面图：请输入页号(剖面编号)，如p1(回车)、p2(回车)……"
	   "打印：请输入p(回车)"
	  )
  )

  (command "_.color" 5)
  (setq	i 0
	x -10
	y 2
  )
  (repeat (length a)
    (setq txt1 (nth i a)
	  i    (1+ i)
    )
    (setq y   (- y 2)
	  tp1 (list x y)
    )
    (command "_.text" "s" "style3" "ml" tp1 1.5 0 txt1)
  )
  ;;end repeat
  (command "_.color" "bylayer")

)





(defun c:e ()

;;;  (command "_.style" "style1" "楷体.ttf" "" "" "" "" "" "")
;;;  (command "_.style" "style11" "楷体.ttf" "" "" "" "" "" "")
  (command "_.style" "style1" "楷体_GB2312" "" "" "" "" "" "")
;;;  (command "_.style" "style11" "@SIMKAI.TTF" 0.23 "" "" "" "" "y")
  (command "_.style" "style3" "黑体" "" "" "" "" "" "")
  (command "_.style" "style4" "华文新魏" "" "" "" "" "" "")


  (defun readandwriteyx	(yx)
    (setq ff (open "c:/Gees/标准岩土名称.txt" "r"))
    (setq b ())
    (setq a  nil
	  j  0
	  ay t
    )
    (while (< j 50)			;while1
      (setq a (read-line ff))
      (if (and (/= a nil) (/= a "") (/= a yx)) ;if2
	(progn
;;;progn1111
	  (if (and (<= (strlen a) (strlen yx)) ay)
	    ;;if3333
	    (setq b  (append b (list yx) (list a))
		  j  0
		  ay nil
	    )
	    (setq b (append b (list a))
		  j 0
	    )
	  )
;;;;;;if33333
	)
;;;end progn1111
	(setq j (1+ j))
      )					;end if2
    )					;end while1
    (close ff)
    (setq lb (length b))
    (if	(= lb 0)
      (setq b (append b (list yx)))
    )

    (setq ff (open "c:/Gees/标准岩土名称.txt" "w"))
    (setq i 0
	  s (strcat "\n" "**" (itoa (1- (length b))))
    )
    (repeat (1- (length b))
      (setq c (strcat "\n" (nth i b)))
      (setq i (1+ i))
      (princ c ff)
    )					;end repeat
    (princ s ff)
    (close ff)
  )					;end subfunction1 readandwriteyx function "readfile3(filename)"



  (command "zoom" "all")
  (command)
  (command "explode" "0,0")
  (command)

  (command "limits" "-0.225,-0.225" "0.225,0.225")
  (command "zoom" "w" "-0.3,-0.3" "0.3,0.3")
  (command "grid" "0.0225")
  (command)
  (command "snap" "0.0225")
  (command)
  (command "ucsicon" "off")
  (command "layer" "m" "1" "")
  (command)
  (command "_.layer" "color" "5" "" "")
  (command)
  (command "line" "-0.3,0" "0.3,0" "")
  (command)
  (command "line" "0,-0.3" "0,0.3" "")
  (command)
  (command "rectang" "-0.225,-0.225" "0.225,0.225")
  (command "layer" "lock" "1")
  (command)
  (command "layer" "s" "0" "")
  (command)
  (command "zoom" "w" "-0.3,-0.3" "0.3,0.3")

  (defun c:s ()
    (command "erase" "w" "0.3,3" "3,-3" "")
    (command "line" "1.4,1.1" "1.4,-1.1" "")
    (command "line" "1.6,1.1" "1.6,-1.1" "")
    (command "line" "0.5,0.9" "1.4,0.9" "")
    (command "line" "0.5,-0.9" "1.4,-0.9" "")
    (command "line" "1.6,0.9" "2.5,0.9" "")
    (command "line" "1.6,-0.9" "2.5,-0.9" "")
    (command "copy" "w"	"-0.45,-0.45" "0.45,0.45" "" "m" "-0.225,0.225")
    (command "0.5,0.9"	    "0.5,0.45"	   "0.5,0"
	     "0.5,-0.45"    "0.95,0.9"	   "0.95,0.45"
	     "0.95,0"	    "0.95,-0.45"   ""
	    )
    (command "zoom" "w" "-0.3,1.1" "2.5,-1.1")
    (setq d (getstring "是否保存该岩土花纹？<y>"))

    (if	(or (= d "") (= d "y"))
      (progn
	(setq a (getstring "请输入岩土名称:"))
	(while (or (= a "")
		   (= a " ")
		   (= a "  ")
		   (= a "   ")
		   (= a "    ")
		   (= a "       ")
	       )
	  (setq a (getstring "请输入岩土名称:"))
	)
;;;end while
	(setq yx a)
	(setq a (strcat "c:/Gees/岩土花纹/" a))
	(setq b (findfile (strcat a ".dwg")))
	(if (= b nil)
;;;if 1
	  (progn
	    (command "wblock"	a	   ""	      "0,0"
		     "w"	"-0.45,-0.45"	      "0.45,0.45"
		     ""
		    )
	    (setq myyx yx)
	    (setq myyx (apply 'wtfmc (list myyx)))
	    (apply 'readandwriteyx (list myyx))
	    (setq myyx (apply 'cwtfmc (list myyx)))
	    (apply 'readandwriteyx (list myyx))
	    (command "zoom" "all")
	    (command "erase" "w" "-10,-10" "10,10" "")
	    (command "zoom" "all")
	  )
;;;end progn 
	  (progn
	    (setq
	      c	(getstring (strcat a "----" "已存在！是否覆盖？<y>"))
	    )
	    (if	(= c "n")
	      (command)
	    )

	    (if	(or (= c "") (= c "y"))
	      (progn
		(command "wblock"   a	       "y"	  ""
			 "0,0"	    "w"	       "-0.45,-0.45"
			 "0.45,0.45"	       ""
			)
		(setq myyx yx)
		(setq myyx (apply 'wtfmc (list myyx)))
		(apply 'readandwriteyx (list myyx))
		(setq myyx (apply 'cwtfmc (list myyx)))
		(apply 'readandwriteyx (list myyx))
		(command "zoom" "all")
		(command "erase" "w" "-10,-10" "10,10" "")
		(command "zoom" "all")
	      )
	      ;;end progn
	    )

	  )
	  ;;progn
	)
	;;end if1
      )
;;;end progn
    )
;;;end if
    (if	(or (/= d "") (/= d "y"))
      (progn

	(command "zoom" "all")
	(command "erase" "w" "1000,1000" "0.45,-1000" "")
	(command "zoom" "all")
	(command "zoom" "all")

      )
;;;end progn
    )
;;;endif



  )
;;;end defun s()

)
;;;end defun e()

(defun c:vv ()

  (setq ff (open "c:/Gees/标准岩土名称.txt" "r"))
  (setq b ())
  (setq	a nil
	j 0
  )
  (while (< j 50)			;while1
    (setq a (read-line ff))
    (if	(and (/= a nil) (/= a ""))	;if2
      (setq b (append b (list a))
	    j 0
      )
      (setq j (1+ j))
    )					;end if2
  )					;end while1
  (close ff)
  (setq yxmcprint b)

  (setq	x 0
	y 3.3
	i -1
  )
  (repeat (- (length yxmcprint) 1)
;;;repeat1
    (setq y (- y 0.3)
	  x -1
    )
    (if	(< i (- (length yxmcprint) 1))
      (repeat 3
;;;repeat2
	(setq i	(1+ i)
	      x	(+ x 4)
	)

	(if (< i (- (length yxmcprint) 1))
	  (progn
	    (setq pt (list x y))
	    (setq txt (nth i yxmcprint))
	    (setq txt (strcat (itoa (1+ i)) "、" txt))
	    (command "_.text" "s" "style1" "j" "ml" pt 0.23 0 txt)
	  )
	)

      )
      ;;end repeat2
    )
;;;end if
  )
;;;end repeat1
  (command "zoom" "W" "3,3.6" "15,-3")
  (setq aaa "  ")
  (while (/= aaa "")
    (setq aaa (getstring "请输入岩土名称或序号：\n"))
    (if	(and (> (atoi aaa) 0) (<= (atoi aaa) (length yxmcprint)))
      (setq aaa (nth (1- (atoi aaa)) yxmcprint))
    )
    ;;end if
    (setq a (strcat "c:/Gees/岩土花纹/" aaa))
    (setq b (findfile (strcat a ".dwg")))
    (if	(/= b nil)
;;;if 1
      (progn
	(command "zoom" "w" "-0.3,1.1" "2.5,-1.1")
	(command "erase" "c" "2.5,-1.1" "-1,1" "")
	(command)
	(command "insert" a "0,0" "" "" "")
	(command)
	(command "erase" "w" "0.3,3" "3,-3" "")
	(command "line" "1.4,1.1" "1.4,-1.1" "")
	(command "line" "1.6,1.1" "1.6,-1.1" "")
	(command "line" "0.5,0.9" "1.4,0.9" "")
	(command "line" "0.5,-0.9" "1.4,-0.9" "")
	(command "line" "1.6,0.9" "2.5,0.9" "")
	(command "line" "1.6,-0.9" "2.5,-0.9" "")
	(command "minsert" a "0.725,0.675" "" "" "" 4 2 -0.45 0.45)
	(command "zoom" "w" "-0.3,1.1" "2.5,-1.1")
	(command "_.text" "s" "style1" "j" "ml" "1.8,0" 0.23 0 aaa)

      )
;;;end progn
      (princ (strcat aaa "花纹不存在，请进行编辑！" "\n"))
    )
;;;end if 1
  )
;;;end while

)
;;;end defun pv()

(defun c:vs ()
;;;  (command "_.style" "style1" "楷体.ttf" "" "" "" "" "" "")
;;;  (command "_.style" "style11" "楷体.ttf" "" "" "" "" "" "")
  (command "_.style" "style1" "楷体_GB2312" "" "" "" "" "" "")
;;;  (command "_.style" "style11" "@SIMKAI.TTF" 0.23 "" "" "" "" "y")
  (command "_.style" "style3" "黑体" "" "" "" "" "" "")
  (command "_.style" "style4" "华文新魏" "" "" "" "" "" "")

  (setq ff (open "c:/Gees/标准岩土名称.txt" "r"))
  (setq b ())
  (setq	a nil
	j 0
  )
  (while (< j 50)			;while1
    (setq a (read-line ff))
    (if	(and (/= a nil) (/= a ""))	;if2
      (setq b (append b (list a))
	    j 0
      )
      (setq j (1+ j))
    )					;end if2
  )					;end while1
  (close ff)
  (setq yxmcprint b)

  (setq	x 0
	y 3.3
	i -1
  )
  (repeat (- (length yxmcprint) 1)
;;;repeat1
    (setq y (- y 0.3)
	  x -1
    )
    (if	(< i (- (length yxmcprint) 1))
      (repeat 3
;;;repeat2
	(setq i	(1+ i)
	      x	(+ x 4)
	)

	(if (< i (- (length yxmcprint) 1))
	  (progn
	    (setq pt (list x y))
	    (setq txt (nth i yxmcprint))
	    (setq txt (strcat (itoa (1+ i)) "、" txt))
	    (command "_.text" "s" "style1" "j" "ml" pt 0.23 0 txt)
	  )
	)

      )
      ;;end repeat2
    )
;;;end if
  )
;;;end repeat1
  (command "zoom" "W" "3,3.6" "15,-3")
  (setq aaa "  ")
  (while (/= aaa "")
    (setq aaa (getstring "请输入岩土名称或序号：\n"))
    (if	(and (> (atoi aaa) 0) (<= (atoi aaa) (length yxmcprint)))
      (setq aaa (nth (1- (atoi aaa)) yxmcprint))
    )
    ;;end if
    (setq a (strcat "c:/Gees/岩土花纹/" aaa))
    (setq b (findfile (strcat a ".dwg")))
    (if	(/= b nil)
;;;if 1
      (progn
	(command "erase" "c" "2.5,-1.1" "-1,1" "")
	(command)
	(command "insert" a "0,0" "" "" "")
	(command)
	(command "erase" "w" "0.3,3" "3,-3" "")
	(command "line" "1.4,1.1" "1.4,-1.1" "")
	(command "line" "1.6,1.1" "1.6,-1.1" "")
	(command "line" "0.5,0.9" "1.4,0.9" "")
	(command "line" "0.5,-0.9" "1.4,-0.9" "")
	(command "line" "1.6,0.9" "2.5,0.9" "")
	(command "line" "1.6,-0.9" "2.5,-0.9" "")
	(command "minsert" a "0.725,0.675" "" "" "" 4 2 -0.45 0.45)
	(command "zoom" "w" "-0.3,3.6" "15,-3")
	(command "_.text" "s" "style1" "j" "ml" "1.8,0" 0.23 0 aaa)

      )
;;;end progn
      (princ (strcat aaa "花纹不存在，请进行编辑！" "\n"))
    )
;;;end if 1
  )
;;;end while

)
;;;end defun pv()



(defun c:pp ()
  (if (= (nth 31 gcwzb) "1")
    (setq plotstyle "pmtA4")
    (SETQ plotstyle "other")
  )
;;;;ENDIF
  (command "zoom" "all")
  (command "erase" "ALL" "" "")
  (command)
  (command "linetype" "s" "bylayer" "" "" "")
  (command)
  (defun gcwzf (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)"
  (setq gcrecode (apply 'gcwzf (list "c:/Gees/gcwz.txt")))
  (setq gcwz (car gcrecode))		;end read-data-function "readfile1(filename)"


  (defun gcdataf (g)
    (setq ff (open g "r"))
    (setq a nil)
    (setq a (read-line ff))


    (if	(= a "**gcgk")
;;;;if**gcgk
      (progn
	(setq i 0)
	(setq a (read-line ff))
	(while (/= a "**zzt")
	  (if (< i 17)
	    (setq gcgkb (append gcgkb (list a)))
	  )
	  (setq i (+ i 1))
	  (setq a (read-line ff))
	)
	;;end while
      )
      ;;end progn
    )
;;;end if**gcgk

    (while (/= a "**pmt")
      (setq a (read-line ff))
    )
    ;;end while


    (setq a (read-line ff))
    (while (/= (substr a 1 2) "**")
      (if (= a "---pmt")
;;;;if**gcgk
	(progn
	  (setq b ())
	  (setq a (read-line ff))
	  (while (and (/= a "---pmt") (/= (substr a 1 2) "**"))
;;;while**zk1
	    (setq b (append b (list a)))
	    (setq a (read-line ff))
	    (setq a (read-line ff))
	    (setq a (read-line ff))
	  )
	  ;;end while**zk1
	  (if (/= b nil)
	    (setq pmb (append pmb (list b)))
	  )
	)
	;;end progn
      )
;;;end if**gcgk
    )
;;;end while  

    (setq x ""
	  y ""
    )
    (while (and (/= a "**end") (/= a nil))
;;;;while************************************
      (if (= (substr a 1 2) "**")
;;;if-------------
	(progn
	  (setq a (read-line ff))
	  (setq a (read-line ff))
	  (setq a (read-line ff))
	  (setq zkb (append zkb (list a)))
	  (setq x (read-line ff))
	  (setq y (read-line ff))
	  (setq zkxy (append zkxy (list (atof y) (atof x))))
	  (setq a (read-line ff))
	  (setq zkg (append zkg (list a)))
	  (setq a (read-line ff))
	  (setq a (read-line ff))
	  (setq a (read-line ff))
	  (setq a (read-line ff))
	  (setq a (read-line ff))
	  (setq a (read-line ff))
	  (setq a (read-line ff))
	  (setq a (read-line ff))
	  (setq a (read-line ff))
	  (setq zkzlb (append zkzlb (list a)))
	)
	;;end progn	   
      )
;;;end if--------------------
      (while (/= (substr a 1 2) "**")
;;;while111
	(setq a (read-line ff))
      )
;;;end while111

    )
;;;end while**********************************************


    (close ff)
  )					;end read-data-function "readfile1(filename)"
  (setq	gcgkb ()
	zkb ()
	zkg ()
	zkxy ()
	zkzlb ()
	pmb ()
	bdt t
	bxt t
  )
  (apply 'gcdataf (list gcwz))
  (if (or (= (nth 3 gcgkb) "") (= (nth 4 gcgkb) ""))
    (setq bdt nil)
  )
;;;endif
  (if (or (= (nth 6 gcgkb) "")
	  (= (nth 7 gcgkb) "")
	  (= (nth 8 gcgkb) "")
	  (= (nth 9 gcgkb) "")
      )
    (setq bxt nil)
  )
;;;;endif
  (setq pmdb ())

  (if (= bdt t)
    (progn
      (setq pmdb (append pmdb (list (atof (nth 4 gcgkb)))))
      (setq pmdb (append pmdb (list (atof (nth 3 gcgkb)))))
    )
;;;endprogn
    (progn
      (setq pmdb (append pmdb (list (nth 0 zkxy))))
      (setq pmdb (append pmdb (list (nth 1 zkxy))))
    )
;;;endprogn
  )
  ;;endifbdt

  (setq	i     0
	x1min 10000000000000.0
	y1min 1000000000000.000
	y1max -10000000000000.00
  )
  (repeat (/ (length zkxy) 2)
    (if	(> x1min (nth i zkxy))
      (setq x1min (nth i zkxy))
    )
    (setq i (1+ i))
    (if	(> y1min (nth i zkxy))
      (setq y1min (nth i zkxy))
    )
    (if	(< y1max (nth i zkxy))
      (setq y1max (nth i zkxy))
    )
    (setq i (1+ i))
  )
;;;endrepeat




  (if (= bxt t)
    (progn
      (setq pmdb (append pmdb (list (atof (nth 7 gcgkb)))))
      (setq pmdb (append pmdb (list (atof (nth 6 gcgkb)))))
      (setq pmdb (append pmdb (list (atof (nth 9 gcgkb)))))
      (setq pmdb (append pmdb (list (atof (nth 8 gcgkb)))))
    )
;;;endprogn
    (progn
      (setq pmdb (append pmdb (list x1min)))
      (setq pmdb (append pmdb (list y1min)))
      (setq pmdb (append pmdb (list x1min)))
      (setq pmdb (append pmdb (list y1max)))
    )
;;;endprogn
  )
;;;endif







  (setq	i 16
	j 0
	ypmdb ()
  )
  (while (< i (length gcgkb))
;;;while111111111
    (if	(and (/= (nth i gcgkb) "")
	     (/= (nth i gcgkb) " ")
	     (/= (nth i gcgkb) "  ")
	)
      (progn

	(setq ypmdb (append ypmdb (list (atof (nth i gcgkb)))))
	(setq j (1+ j))
      )
    )
;;;end if 
    (setq i (1+ i))
  )
;;;end while11111111111
  (if (/= (fix (/ j 2.0)) (/ j 2.0))
    (setq ypmdb (append ypmdb (list (nth 1 ypmdb))))
  )
  (setq i 0)
  (repeat (length ypmdb)
    (if	(= (atoi (rtos (/ i 2.00))) (atof (rtos (/ i 2.00))))
      (setq pmdb (append pmdb (list (nth (1+ i) ypmdb))))
      (setq pmdb (append pmdb (list (nth (1- i) ypmdb))))
    )
;;;endif
    (setq i (1+ i))
  )
  ;;endrepeat
  (setq x0 (nth 2 pmdb))
  (setq y0 (nth 3 pmdb))
  (setq x2 (nth 4 pmdb))
  (setq y2 (nth 5 pmdb))

  (if bxt
    (setq a0 (angle (list x0 y0) (list x2 y2)))
    (setq a0 0)
  )
;;;endif
  (setq	fwjx0 x0
	fwjx2 x2
  )

  (setq fwj (* pi (/ (atof (nth 10 gcgkb)) 180)))
  (if (or (= (nth 10 gcgkb) "")
	  (= (nth 10 gcgkb) " ")
	  (= (nth 10 gcgkb) "  ")
	  (= (nth 10 gcgkb) "   ")
      )
    (progn
      (setq fwj (- (/ pi 2) (angle (list x0 y0) (list x2 y2))))
      (if (< fwj 0)
	(setq fwj (+ (* pi 2) fwj))
      )
    )
  )
;;;endif


  (setq zbza (+ a0 fwj))
  (if (<= a0 (* pi 0.5))
    (setq a1 a0)
  )
  (if (and (> a0 (* pi 0.5)) (<= a0 (* 1.5 pi)))
    (setq a1 (- a0 pi))
  )
  (if (> a0 (* pi 1.5))
    (setq a1 (- a0 pi pi))
  )
  (if bxt
    (setq zbzar a1)
    (setq zbzar (- (/ pi 2)))
  )
;;;endif  
  (defun rotatepmt (x y)
    (setq lo (sqrt (+ (* (- x x0) (- x x0)) (* (- y y0) (- y y0)))))
    (if	(/= (- x x0) 0)
;;;if***********
      (progn
;;;;progn 
	(setq an (atan (/ (- y y0) (- x x0))))
	(if (>= an 0)
;;;if11111111
	  (if (< (- x x0) 0)
	    (setq an (+ an pi))
	  )
	)
;;;end if 11111111 
	(if (< an 0)
;;;if222222
	  (if (> (- x x0) 0)
	    (setq an (+ (* 2 pi) an))
	    (setq an (+ pi an))
	  )
;;;endif
	)
;;;;end if222222222  
      )
;;;;end progn 
      (if (>= (- y y0) 0)
;;;if-----------
	(setq an (/ pi 2))
	(setq an (- (/ pi 2)))
      )
;;;endif------------------
    )
    ;;end if***********************
    (setq an (- an a1))
    (setq dx (* lo (cos an)))
    (setq dy (* lo (sin an)))
    (setq x1 (+ x0 dx)
	  y1 (+ y0 dy)
    )
  )
;;;;end defun
  (setq pmdb1 ())
  (setq i 0)
  (repeat (/ (length pmdb) 2)
    (setq x (nth i pmdb))
    (setq i (1+ i))
    (setq y (nth i pmdb))
    (setq i (1+ i))
    (apply 'rotatepmt (list x y))
    (setq pmdb1 (append pmdb1 (list x1)))
    (setq pmdb1 (append pmdb1 (list y1)))
  )
  (setq zkxy1 ())
  (setq i 0)
  (repeat (/ (length zkxy) 2)
    (setq x (nth i zkxy))
    (setq i (1+ i))
    (setq y (nth i zkxy))
    (setq i (1+ i))
    (apply 'rotatepmt (list x y))
    (setq zkxy1 (append zkxy1 (list x1)))
    (setq zkxy1 (append zkxy1 (list y1)))
  )

  (if (> fwjx0 fwjx2)
    (progn
      (setq pmdbtemp ()
	    i 0
      )
      (repeat (length pmdb1)
	(setq pmdbtemp (append pmdbtemp (list (- 0 (nth i pmdb1)))))
	(setq i (1+ i))
      )
;;;endrepeat
      (setq pmdb1 pmdbtemp)
    )
;;;endprogn
  )
;;;endif
  (if (> fwjx0 fwjx2)
    (progn
      (setq pmdbtemp ()
	    i 0
      )
      (repeat (length zkxy1)
	(setq pmdbtemp (append pmdbtemp (list (- 0 (nth i zkxy1)))))
	(setq i (1+ i))
      )
;;;endrepeat
      (setq zkxy1 pmdbtemp)
    )
;;;endprogn
  )
;;;endif

  (setq bbb (append pmdb1 zkxy1))


  (setq	xmin 100000000000.00
	xmax -100000000000.00
	ymin 100000000000.00
	ymax -100000000000.00
	i    0
  )
  (repeat (/ (length bbb) 2)
    (if	(< (nth i bbb) xmin)
      (setq xmin (nth i bbb))
    )
    (if	(> (nth i bbb) xmax)
      (setq xmax (nth i bbb))
    )
    (setq i (1+ i))
    (if	(< (nth i bbb) ymin)
      (setq ymin (nth i bbb))
    )
    (if	(> (nth i bbb) ymax)
      (setq ymax (nth i bbb))
    )
    (setq i (1+ i))
  )
  ;;end repeat
  (setq	dx (- xmax xmin)
	dy (- ymax ymin)
  )
  (setq	blh (/ dx 28)
	blv (/ dy 18)
  )
  (if (> blh blv)
    (setq bla3 blh)
    (setq bla3 blv)
  )
  (setq	blh (/ dx 21)
	blv (/ dy 11)
  )
  (if (> blh blv)
    (setq bla4 blh)
    (setq bla4 blv)
  )
  (setq	bl3 10
	bl4 10
  )
  (setq bl 0)
  (while (> bla3 bl)
    (setq bl (+ bl 0.5))
    (setq bl3 bl)
  )

  (setq bl 0)
  (while (> bla4 bl)
    (setq bl (+ bl 0.5))
    (setq bl4 bl)
  )
  (if (= (nth 31 gcwzb) "1")
    (setq bl3 bl4)
  )
  (setq blyes (nth 12 gcgkb))
  (setq blyes (atof blyes))
  (if (> blyes 0.1)
    (setq bl3 (/ blyes 100))
  )
  (setq	px (+ (/ xmin bl3) (/ dx bl3 2))
	py (+ (/ ymin bl3) (/ dy bl3 2))
  )




  (if (= (nth 31 gcwzb) "1")
    (setq p00 (list (- px 11) (- py 7.75))
	  p01 (list (+ px 14.7) (+ py 8.75))
    )

    (setq p00 (list (- px 15.3) (- py 11.5))
	  p01 (list (+ px 20.7) (+ py 14.5))
    )
  )
;;;endif


  (command "rectang" "w" 0.09 p00 p01)
  (setq	p001 p00
	p002 p01
  )
  (setq	pmdb2 ()
	i 0
  )
  (setq	p001 p00
	p002 p01
  )
  (repeat (length pmdb1)
    (setq pmdb2 (append pmdb2 (list (/ (nth i pmdb1) bl3))))
    (setq i (1+ i))
  )
  ;;end repeat
  (setq	zkxy2 ()
	i 0
  )
  (repeat (length zkxy1)
    (setq zkxy2 (append zkxy2 (list (/ (nth i zkxy1) bl3))))
    (setq i (1+ i))
  )
  ;;end repeat
  (setq	zkzlb2 ()
	i 0
  )
  (repeat (length zkzlb)
    (setq a (atoi (nth i zkzlb)))
    (cond
      ((= a 0)
       (setq
	 zkzlb2
	  (append zkzlb2 (list "c:/Gees/岩土花纹/普通孔.dwg"))
       )
      )
      ((= a 1)
       (setq
	 zkzlb2
	  (append zkzlb2 (list "c:/Gees/岩土花纹/技术孔.dwg"))
       )
      )
      ((= a 2)
       (setq
	 zkzlb2
	  (append zkzlb2 (list "c:/Gees/岩土花纹/动探孔.dwg"))
       )
      )
      ((= a 3)
       (setq
	 zkzlb2
	  (append zkzlb2 (list "c:/Gees/岩土花纹/静探孔.dwg"))
       )
      )
      ((= a 4)
       (setq
	 zkzlb2	(append
		  zkzlb2
		  (list "c:/Gees/岩土花纹/十字板剪切试验孔.dwg")
		)
       )
      )
      ((= a 5)
       (setq zkzlb2
	      (append zkzlb2 (list "c:/Gees/岩土花纹/注水试验孔.dwg"))
       )
      )
      ((= a 6)
       (setq zkzlb2
	      (append zkzlb2 (list "c:/Gees/岩土花纹/压水试验孔.dwg"))
       )
      )
      ((= a 7)
       (setq zkzlb2
	      (append zkzlb2 (list "c:/Geesk/岩土花纹/灌浆钻孔.dwg"))
       )
      )
    )
    (setq i (1+ i))
  )
  ;;end repeat
  (setq i 0)
  (repeat (length zkzlb2)
    (setq i1 (* i 2)
	  i2 (1+ (* i 2))
    )
    (setq p1 (list (nth i1 zkxy2) (nth i2 zkxy2)))
    (setq p2 (list (+ (nth i1 zkxy2) 0.2) (- (nth i2 zkxy2) 0.4)))
    (setq txt1 (nth i zkb))
    (command "_.text" "s" "style1" "ml" p2 0.3 0 txt1)
    (setq bm (nth i zkzlb2))
    (if	(/= (findfile bm) nil)
      (command "insert" bm p1 "" "" "")
    )
;;;end if
    (if	(= (nth 32 gcwzb) "1")
      (progn
	(setq zkl (strlen txt1))
	(setq zkl (+ (* zkl 0.2) 0.2))
	(setq px (list (+ (car p2) zkl) (+ (cadr p2) 0.2)))
	(setq py (list (+ (car p2) zkl) (cadr p2)))
	(setq pz (list (+ (car p2) zkl) (- (cadr p2) 0.2)))
	(setq sx (strcat "X=" (rtos (+ 0.000 (nth i2 zkxy)) 2 3)))
	(setq lx (* (strlen sx) 0.125))
	(setq sy (strcat "Y=" (rtos (+ 0.000 (nth i1 zkxy)) 2 3)))
	(setq ly (* (strlen sy) 0.125))
	(setq sz (strcat "Z=" (rtos (atof (nth i zkg)) 2 3)))
	(setq lz (* (strlen sz) 0.125))
	(command "_.text" "s" "style1" "ml" px 0.18 0 sx)
	(command "_.text" "s" "style1" "ml" py 0.18 0 sy)
	(command "_.text" "s" "style1" "ml" pz 0.18 0 sz)
	(setq p1 (list (- (car pz) 0.1) (- (cadr pz) 0.15)))
	(if (< lx ly)
	  (setq lx ly)
	)
	(if (< lx lz)
	  (setq lx lz)
	)
	(setq p2 (list (+ (car p1) lx 0.15) (+ (cadr p1) 0.7)))
	(command "rectang" "w" 0.018 p1 p2)
      )
;;;endprogn
    )
;;;;;endif
    (setq i (1+ i))
  )
;;;end repeat

  (if (/= bdt nil)
    (progn
      (setq pb (list (nth 0 pmdb2) (nth 1 pmdb2)))
      (setq p2 (list (+ (nth 0 pmdb2) 0.2) (- (nth 1 pmdb2) 0.4)))
      (setq txt1 (nth 5 gcgkb))
      (command "_.text" "s" "style1" "ml" p2 0.3 0 txt1)

      (if (= (nth 32 gcwzb) "1")
	(progn
	  (setq zkl (strlen txt1))
	  (setq zkl (+ (* zkl 0.2) 0.2))
	  (setq px (list (+ (car p2) zkl) (+ (cadr p2) 0.1)))
	  (setq pz (list (+ (car p2) zkl) (- (cadr p2) 0.1)))
	  (setq sx (strcat "X=" (rtos (+ 0.000 (nth 1 pmdb)) 2 3)))
	  (setq lx (* (strlen sx) 0.125))
	  (setq sz (strcat "Y=" (rtos (+ 0.000 (nth 0 pmdb)) 2 3)))
	  (setq lz (* (strlen sz) 0.125))
	  (command "_.text" "s" "style1" "ml" px 0.18 0 sx)
	  (command "_.text" "s" "style1" "ml" pz 0.18 0 sz)
	  (setq p1 (list (- (car pz) 0.1) (- (cadr pz) 0.15)))
	  (if (< lx lz)
	    (setq lx lz)
	  )
	  (setq p2 (list (+ (car p1) lx 0.15) (+ (cadr p1) 0.5)))
	  (command "rectang" "w" 0.018 p1 p2)
	)
;;;endprogn
      )


      (setq bm "c:/Gees/岩土花纹/基点.dwg")
      (if (/= (findfile bm) nil)
	(command "insert" bm pb "" "" "")
      )
;;;;end if
    )
    ;;end progn
  )
;;;end if

  (setq	i   3
	fyb ()
  )
  (repeat (- (/ (length pmdb2) 2) 3)
    (setq
      fyb (append
	    fyb
	    (list (list (nth (* i 2) pmdb2) (nth (1+ (* i 2)) pmdb2)))
	  )
    )
    (setq i (1+ i))
  )
;;;;end rpeat
  (setq i 1)
  (IF (/= FYB NIL)
;;;IF 000000000
    (progn (setq p1 (nth 0 fyb))
;;;;;;(command "_.pline" p1 "w" 0.03 "")   注消勘察区范围绘制，恢复时请去掉前边的;;;; 注消勘察区范围绘制，恢复时请去掉前边的;;;; 注消勘察区范围绘制，恢复时请去掉前边的;;;; 注消勘察区范围绘制，恢复时请去掉前边的;;;; 注消勘察区范围绘制，恢复时请去掉前边的;;;; 注消勘察区范围绘制，恢复时请去掉前边的;;;; 注消勘察区范围绘制，恢复时请去掉前边的;;;; 注消勘察区范围绘制，恢复时请去掉前边的;;;; 注消勘察区范围绘制，恢复时请去掉前边的;;;; 注消勘察区范围绘制，恢复时请去掉前边的;;;; 注消勘察区范围绘制，恢复时请去掉前边的;;;; 注消勘察区范围绘制，恢复时请去掉前边的;;;; 注消勘察区范围绘制，恢复时请去掉前边的;;;; 注消勘察区范围绘制，恢复时请去掉前边的;;;; 注消勘察区范围绘制，恢复时请去掉前边的;;;; 注消勘察区范围绘制，恢复时请去掉前边的;;;; 注消勘察区范围绘制，恢复时请去掉前边的;;;; 注消勘察区范围绘制，恢复时请去掉前边的;;;; 注消勘察区范围绘制，恢复时请去掉前边的;;;; 注消勘察区范围绘制，恢复时请去掉前边的;;;; 注消勘察区范围绘制，恢复时请去掉前边的;;;;
	   (repeat (1- (length fyb))
	     (setq p1 (nth i fyb))
	     (command p1)
	     (setq i (1+ i))
	   )
;;;end repeat
	   (command "")
	   (command)
    )
    ;;progn
  )
;;;DND IF0000000000000000000000000
  (if (= (nth 31 gcwzb) "1")
    (setq p1 (list (- (car p01) 2.3) (- (cadr p01) 2.5)))
    (setq p1 (list (- (car p01) 3) (- (cadr p01) 3)))
  )
  (setq bm "c:/Gees/岩土花纹/指北针")
  (setq an2 (- (* 180 (/ (- zbza zbzar) pi)) 90))
  (if (> fwjx0 fwjx2)
    (setq an2 (+ an2 180))
  )
  (command "insert" bm p1 "" "" an2)


  (setq k 0)
  (repeat (length pmb)
;;;;;;repeat***************
    (setq pmxb1 (nth k pmb))
    (setq k (1+ k))
    (if	(> (length pmxb1) 2)
;;;;if***********
      (progn
;;;;;;progn***********
	(setq pmxb2 ()
	      i	0
	)
	(repeat	(1- (length pmxb1))
;;;repeat11111
	  (setq i (1+ i))
	  (setq zk (nth i pmxb1))
	  (setq j 0)
	  (while (and (/= (nth j zkb) zk) (< j (length zkb)))
	    (setq j (1+ j))
	  )
	  (setq	pmxb2
		 (append
		   pmxb2
		   (list (nth (* j 2) zkxy2) (nth (1+ (* j 2)) zkxy2))
		 )
	  )
	)
	;;end repeat1111111111
	(setq dx (- (nth 0 pmxb2) (nth 2 pmxb2)))
	(setq dy (- (nth 1 pmxb2) (nth 3 pmxb2)))
	(setq l (sqrt (+ (* dx dx) (* dy dy))))
	(if (= l 0)
	  (setq l 1)
	)
	(setq p1 (list (+ (/ dx l) (nth 0 pmxb2))
		       (+ (/ dy l) (nth 1 pmxb2))
		 )
	)
	(setq l (/ l 1.3))
	(setq pt1 (list	(+ (/ dx l) (nth 0 pmxb2))
			(+ (/ dy l) (nth 1 pmxb2))
		  )
	)

	(setq l0 (length pmxb2))
	(setq dx (- (nth (- l0 2) pmxb2) (nth (- l0 4) pmxb2)))
	(setq dy (- (nth (- l0 1) pmxb2) (nth (- l0 3) pmxb2)))
	(setq l (sqrt (+ (* dx dx) (* dy dy))))

	(if (= l 0)
	  (setq l 1)
	)
	(setq p2 (list (+ (/ dx l) (nth (- l0 2) pmxb2))
		       (+ (/ dy l) (nth (- l0 1) pmxb2))
		 )
	)
	(setq l (/ l 1.3))
	(setq pt2 (list	(+ (/ dx l) (nth (- l0 2) pmxb2))
			(+ (/ dy l) (nth (- l0 1) pmxb2))
		  )
	)

	(command "pline" p1 "w" 0.012 "")
	(setq i 0)
	(repeat	(/ (length pmxb2) 2)
;;;repeat2222
	  (setq p (list (nth (* i 2) pmxb2) (nth (1+ (* i 2)) pmxb2)))
	  (command p)
	  (setq i (1+ i))
	)
	;;end repeat222222
	(command p2 "")
	(command)
	(setq txt1 (nth 0 pmxb1))
	(command "_.text" "s" "style1" "m" pt1 0.3 0 txt1)
	(setq txt1 (strcat (nth 0 pmxb1) "'"))
	(command "_.text" "s" "style1" "m" pt2 0.3 0 txt1)
      )
;;;;;end progn*************	
    )
    ;;end if**********************
  )
;;;end repeat*******************
  (setq p1 (list (nth 2 pmdb2) (nth 3 pmdb2)))
  (setq p2 (list (nth 4 pmdb2) (nth 5 pmdb2)))
  (setq txt (nth 11 gcgkb))
  (setq	tp (list (/ (+ (nth 2 pmdb2) (nth 4 pmdb2)) 2)
		 (/ (+ (nth 3 pmdb2) (nth 5 pmdb2)) 2)
	   )
  )

  (if (= bxt t)
    (progn
      (command "linetype" "l" "acad_iso04w100" "" "" "")
      (command)
      (command "linetype" "s" "acad_iso04w100" "" "" "")
      (command)
      (if (= cad "2000")
	(command "ltscale" 0.05)
	(command "ltscale" 0.05)
      )
      (if (and (/= txt "") (/= txt " ") (/= txt "  ") (/= txt "   "))
	(command "pline" p1 "w" 0.013 "" p2 "")
	(command)
      )
      (command "linetype" "s" "bylayer" "" "" "")
      (command)
    )
;;;end progn
  )
;;;endif




  (if (and (/= txt "") (/= txt " ") (/= txt "  ") (/= txt "   "))
;;; if22222222
    (progn
      (setq tp (list (car tp) (+ (cadr tp) 0.3)))
      (command "_.text" "s" "style1" "m" tp 0.3 0 txt)
    )
;;;end progn22222222 
  )
;;;end if22222222222
  (if (= (nth 31 gcwzb) "1")
    (progn
;;;;progn A4
      (setq tp (list (/ (+ (car p00) (car p01)) 2) (- (cadr p01) 1)))
      (setq txt "钻  孔  平  面  布  置  图")
      (command "_.text" "s" "style4" "m" tp 0.43 0 txt)
      (setq tp (list (/ (+ (car p00) (car p01)) 2) (- (cadr p01) 1.8)))
      (setq txt (strcat "比 例   1:" (itoa (fix (* bl3 100)))))
      (command "_.text" "s" "style4" "m" tp 0.3 0 txt)

      (setq p1 (list (car p00) (+ (cadr p00) 0.7)))
      (setq p2 (list (+ (car p00) 25.7) (+ (cadr p00) 0.7)))
      (command "_.pline" p1 "w" 0.04 "" p2 "")
      (setq p1 (list (+ (car p00) 6) (+ (cadr p00) 0)))
      (setq p2 (list (+ (car p00) 6) (+ (cadr p00) 0.7)))
      (command "_.pline" p1 "w" 0.013 "" p2 "")
      (setq tp (list (+ (car p00) 3) (+ (cadr p00) 0.35)))
      (setq txt (strcat (nth 1 gcgkb) "  " (nth 0 gcgkb)))
      (command "_.text" "s" "style1" "m" tp 0.23 0 txt)
      (setq p1 (list (+ (car p00) 11) (+ (cadr p00) 0)))
      (setq p2 (list (+ (car p00) 11) (+ (cadr p00) 0.7)))
      (command "_.pline" p1 "w" 0.013 "" p2 "")
      (setq tp (list (+ (car p00) 8.5) (+ (cadr p00) 0.35)))
      (command "_.text"	   "s"	       "style1"	   "m"
	       tp	   0.23	       0	   "钻孔平面布置图"
	      )
      (setq p1 (list (+ (car p00) 12.2) (+ (cadr p00) 0)))
      (setq p2 (list (+ (car p00) 12.2) (+ (cadr p00) 0.7)))
      (command "_.pline" p1 "w" 0.013 "" p2 "")
      (setq tp (list (+ (car p00) 11.6) (+ (cadr p00) 0.35)))
      (command "_.text" "s" "style1" "m" tp 0.23 0 "编制")
      (setq tp (list (+ (car p00) 13.1) (+ (cadr p00) 0.35)))
      (command "_.text" "s" "style1" "m" tp 0.23 0 "")
      (setq p1 (list (+ (car p00) 14) (+ (cadr p00) 0)))
      (setq p2 (list (+ (car p00) 14) (+ (cadr p00) 0.7)))
      (command "_.pline" p1 "w" 0.013 "" p2 "")
      (setq tp (list (+ (car p00) 14.6) (+ (cadr p00) 0.35)))
      (command "_.text" "s" "style1" "m" tp 0.23 0 "复核")
      (setq p1 (list (+ (car p00) 15.2) (+ (cadr p00) 0)))
      (setq p2 (list (+ (car p00) 15.2) (+ (cadr p00) 0.7)))
      (command "_.pline" P1 "w" 0.013 "" P2 "")
      (setq p1 (list (+ (car p00) 17) (+ (cadr p00) 0)))
      (setq p2 (list (+ (car p00) 17) (+ (cadr p00) 0.7)))
      (command "_.pline" P1 "w" 0.013 "" P2 "")
      (setq tp (list (+ (car p00) 17.6) (+ (cadr p00) 0.35)))
      (command "_.text" "s" "style1" "m" tp 0.23 0 "审核")
      (setq p1 (list (+ (car p00) 18.2) (+ (cadr p00) 0)))
      (setq p2 (list (+ (car p00) 18.2) (+ (cadr p00) 0.7)))
      (command "_.pline" p1 "w" 0.013 "" p2 "")
      (setq p1 (list (+ (car p00) 20) (+ (cadr p00) 0)))
      (setq p2 (list (+ (car p00) 20) (+ (cadr p00) 0.7)))
      (command "_.pline" p1 "w" 0.013 "" p2 "")
      (setq tp (list (+ (car p00) 20.6) (+ (cadr p00) 0.35)))
      (command "_.text" "s" "style1" "m" tp 0.23 0 "图表号")
      (setq txt9 (nth 13 gcgkb))
      (setq tp (list (+ (car p00) 22.1) (+ (cadr p00) 0.35)))
      (command "_.text" "s" "style1" "m" tp 0.23 0 txt9)

      (setq p1 (list (+ (car p00) 21.2) (+ (cadr p00) 0)))
      (setq p2 (list (+ (car p00) 21.2) (+ (cadr p00) 0.7)))
      (command "_.pline" p1 "w" 0.013 "" p2 "")
      (setq p1 (list (+ (car p00) 23) (+ (cadr p00) 0)))
      (setq p2 (list (+ (car p00) 23) (+ (cadr p00) 0.7)))
      (command "_.pline" p1 "w" 0.013 "" p2 "")
      (setq tp (list (+ (car p00) 24.35) (+ (cadr p00) 0.35)))
      (command "_.text" "s" "style1" "m" tp 0.23 0 "第1页  共1页")

      (setq tp (list (+ (car p00) 24.2) (+ (cadr p00) 9)))
      (command "_.text" "s" "style4" "m" tp 0.3 0 "图 例")

      (setq y	 (+ (cadr p00) 7.6)
	    pmtl ()
	    i	 0
	    ii	 0
      )



      (repeat (length zkb)
	(setq zl (atoi (nth ii zkzlb)))
	(if (= (member zl pmtl) nil)
	  (progn
	    (setq p1 (list (+ (car p00) 21.3) (- y (* i 1))))
	    (setq p2 (list (+ (car p00) 21.8) (- y (* i 1))))
	    (setq p3 (list (+ (car p00) 22.6) (- y (* i 1))))
	    (setq bm (nth ii zkzlb2))
	    (if	(/= (findfile bm) nil)
	      (command "insert" bm p1 "" "" "")
	    )
;;;end if
	    (cond
	      ((= zl 0) (setq txt "普通孔及编号"))
	      ((= zl 1) (setq txt "技术孔及编号"))
	      ((= zl 2) (setq txt "动力触探孔及编号"))
	      ((= zl 3) (setq txt "静力触探孔及编号"))
	      ((= zl 4) (setq txt "十字板试验孔及编号"))
	      ((= zl 5) (setq txt "注水试验孔及编号"))
	      ((= zl 6) (setq txt "压水试验孔及编号"))
	      ((= zl 7) (setq txt "灌浆钻孔及编号"))
	    )
;;;end cond
	    (command "_.text" "s" "style1" "ml" p3 0.23 0 txt)
	    (setq txt (nth ii zkb))
	    (command "_.text" "s" "style1" "ml" p2 0.23 0 txt)
	    (setq i (1+ i))
	  )
;;;end progn 
	)
;;;end if
	(setq ii   (1+ ii)
	      pmtl (append pmtl (list zl))
	)
      )
;;;end repeat
      (if (/= bdt nil)
	(progn
	  (setq p1 (list (+ (car p00) 21.3) (- y (* i 1) -0.2)))
	  (setq p2 (list (+ (car p00) 21.3) (- y (* i 1) 0.2)))
	  (setq p3 (list (+ (car p00) 22.6) (- y (* i 1))))
	  (setq bm "c:/Gees/岩土花纹/基点.dwg")
	  (if (/= (findfile bm) nil)
	    (command "insert" bm p1 "" "" "")
	  )
;;;end if
	  (setq	txt (nth 5 gcgkb)
		j   1
	  )
	  (while (and (<= j (strlen txt)) (/= (substr txt j 1) " "))
	    (setq j (1+ j))
	  )
	  (setq txt (substr txt 1 (1- j)))
	  (command "_.text" "s" "style1" "m" p2 0.23 0 txt)
	  (command "_.text"	 "s"	       "style1"
		   "ml"		 p3	       0.23
		   0		 "基点(场地座标基准点)"
		  )
	)
;;;end progn
	(setq i (1- i))
      )
;;;end if
      (if (/= pmxb2 nil)
	(progn
	  (setq p1 (list (+ (car p00) 20.9) (- y (* i 1) 1)))
	  (setq p2 (list (+ (car p00) 21.4) (- y (* i 1) 1)))
	  (setq p3 (list (+ (car p00) 21.9) (- y (* i 1) 1)))
	  (setq p4 (list (+ (car p00) 22) (- y (* i 1) 1)))
	  (setq p5 (list (+ (car p00) 22.6) (- y (* i 1) 1)))
	  (setq txt (car (car pmb)))
	  (command "_.text" "s" "style1" "ml" p1 0.23 0 txt)
	  (setq txt (strcat txt "'"))
	  (command "_.text" "s" "style1" "ml" p4 0.23 0 txt)
	  (command "_.text"	"s"	     "style1"	  "ml"
		   p5		0.23	     0
		   "工程地质剖面及编号"
		  )
	  (command "_.pline" p2 "w" 0.013 "" p3 "")
	)
;;;end progn
      )
;;;end if  
      (command "zoom" "w" p00 p01)
      (command)

      (setq gcml (nth 30 gcwzb))
      (setq gcmc (nth 0 gcgkb))
      (setq txt1 (strcat gcml gcmc "-" "钻孔平面布置图"))

      (setq txt1
	     (strcat
	       "c:/Gees/岩土工程勘察专家系统/gcrtf/"
	       "钻孔平面布置图"
	     )
      )

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

    )
;;;;END PROGN A4

    (progn
;;;;PROGN A3


      (setq tp (list (/ (+ (car p00) (car p01)) 2) (- (cadr p01) 1.8)))
      (setq txt "钻  孔  平  面  布  置  图")
      (command "_.text" "s" "style4" "m" tp 0.7 0 txt)
      (setq tp (list (/ (+ (car p00) (car p01)) 2) (- (cadr p01) 3)))
      (setq txt (strcat "比 例   1:" (itoa (fix (* bl3 100)))))
      (command "_.text" "s" "style4" "m" tp 0.4 0 txt)

      (setq p1 (list (car p00) (+ (cadr p00) 0.7)))
      (setq p2 (list (+ (car p00) 36) (+ (cadr p00) 0.7)))
      (command "_.pline" p1 "w" 0.04 "" p2 "")
      (setq p1 (list (+ (car p00) 8.5) (+ (cadr p00) 0)))
      (setq p2 (list (+ (car p00) 8.5) (+ (cadr p00) 0.7)))
      (command "_.pline" p1 "w" 0.013 "" p2 "")
      (setq tp1 (list (+ (car p00) 4.25) (+ (cadr p00) 0.35)))
      (setq txt1 (strcat (nth 1 gcgkb) "  " (nth 0 gcgkb)))
      (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 p1 (list (+ (car p00) 14) (+ (cadr p00) 0)))
      (setq p2 (list (+ (car p00) 14) (+ (cadr p00) 0.7)))
      (command "_.pline" p1 "w" 0.013 "" p2 "")
      (setq tp (list (+ (car p00) 11.25) (+ (cadr p00) 0.35)))
      (command "_.text"	   "s"	       "style1"	   "m"
	       tp	   0.23	       0	   "钻孔平面布置图"
	      )
      (setq p1 (list (+ (car p00) 15.7) (+ (cadr p00) 0)))
      (setq p2 (list (+ (car p00) 15.7) (+ (cadr p00) 0.7)))
      (command "_.pline" p1 "w" 0.013 "" p2 "")
      (setq tp (list (+ (car p00) 14.85) (+ (cadr p00) 0.35)))
      (command "_.text" "s" "style1" "m" tp 0.23 0 "编 制")
      (setq tp (list (+ (car p00) 17.2) (+ (cadr p00) 0.35)))
      (command "_.text" "s" "style1" "m" tp 0.23 0 "")
      (setq p1 (list (+ (car p00) 18.5) (+ (cadr p00) 0)))
      (setq p2 (list (+ (car p00) 18.5) (+ (cadr p00) 0.7)))
      (command "_.pline" p1 "w" 0.013 "" p2 "")
      (setq tp (list (+ (car p00) 19.35) (+ (cadr p00) 0.35)))
      (command "_.text" "s" "style1" "m" tp 0.23 0 "复 核")
      (setq p1 (list (+ (car p00) 20.2) (+ (cadr p00) 0)))
      (setq p2 (list (+ (car p00) 20.2) (+ (cadr p00) 0.7)))
      (command "_.pline" P1 "w" 0.013 "" P2 "")
      (setq p1 (list (+ (car p00) 23) (+ (cadr p00) 0)))
      (setq p2 (list (+ (car p00) 23) (+ (cadr p00) 0.7)))
      (command "_.pline" P1 "w" 0.013 "" P2 "")
      (setq tp (list (+ (car p00) 23.9) (+ (cadr p00) 0.35)))
      (command "_.text" "s" "style1" "m" tp 0.23 0 "审 核")
      (setq p1 (list (+ (car p00) 24.7) (+ (cadr p00) 0)))
      (setq p2 (list (+ (car p00) 24.7) (+ (cadr p00) 0.7)))
      (command "_.pline" p1 "w" 0.013 "" p2 "")
      (setq p1 (list (+ (car p00) 27.5) (+ (cadr p00) 0)))
      (setq p2 (list (+ (car p00) 27.5) (+ (cadr p00) 0.7)))
      (command "_.pline" p1 "w" 0.013 "" p2 "")
      (setq tp (list (+ (car p00) 28.35) (+ (cadr p00) 0.35)))
      (command "_.text" "s" "style1" "m" tp 0.23 0 "图表号")
      (setq txt9 (nth 13 gcgkb))
      (setq tp (list (+ (car p00) 30.6) (+ (cadr p00) 0.35)))
      (command "_.text" "s" "style1" "m" tp 0.23 0 txt9)

      (setq p1 (list (+ (car p00) 29.2) (+ (cadr p00) 0)))
      (setq p2 (list (+ (car p00) 29.2) (+ (cadr p00) 0.7)))
      (command "_.pline" p1 "w" 0.013 "" p2 "")
      (setq p1 (list (+ (car p00) 32) (+ (cadr p00) 0)))
      (setq p2 (list (+ (car p00) 32) (+ (cadr p00) 0.7)))
      (command "_.pline" p1 "w" 0.013 "" p2 "")
      (setq tp (list (+ (car p00) 34) (+ (cadr p00) 0.35)))
      (command "_.text" "s" "style1" "m" tp 0.23 0 "第1页  共1页")

      (setq tp (list (+ (car p00) 32) (+ (cadr p00) 14.6)))
      (command "_.text" "s" "style4" "m" tp 0.33 0 "图 例")

      (setq y	 (+ (cadr p00) 13)
	    pmtl ()
	    i	 0
	    ii	 0
      )



      (repeat (length zkb)
	(setq zl (atoi (nth ii zkzlb)))
	(if (= (member zl pmtl) nil)
	  (progn
	    (setq p1 (list (+ (car p00) 31) (- y (* i 1))))
	    (setq p2 (list (+ (car p00) 31.5) (- y (* i 1))))
	    (setq p3 (list (+ (car p00) 32.5) (- y (* i 1))))
	    (setq bm (nth ii zkzlb2))
	    (if	(/= (findfile bm) nil)
	      (command "insert" bm p1 "" "" "")
	    )
;;;end if
	    (cond
	      ((= zl 0) (setq txt "普通孔及编号"))
	      ((= zl 1) (setq txt "技术孔及编号"))
	      ((= zl 2) (setq txt "动力触探孔及编号"))
	      ((= zl 3) (setq txt "静力触探孔及编号"))
	      ((= zl 4) (setq txt "十字板试验孔及编号"))
	      ((= zl 5) (setq txt "注水试验孔及编号"))
	      ((= zl 6) (setq txt "压水试验孔及编号"))
	      ((= zl 7) (setq txt "灌浆钻孔及编号"))
	    )
;;;end cond
	    (command "_.text" "s" "style1" "ml" p3 0.23 0 txt)
	    (setq txt (nth ii zkb))
	    (command "_.text" "s" "style1" "ml" p2 0.23 0 txt)
	    (setq i (1+ i))
	  )
;;;end progn 
	)
;;;end if
	(setq ii   (1+ ii)
	      pmtl (append pmtl (list zl))
	)
      )
;;;end repeat
      (if (/= bdt nil)
	(progn
	  (setq p1 (list (+ (car p00) 31) (- y (* i 1) -0.2)))
	  (setq p2 (list (+ (car p00) 31) (- y (* i 1) 0.2)))
	  (setq p3 (list (+ (car p00) 32.5) (- y (* i 1))))
	  (setq bm "c:/Gees/岩土花纹/基点.dwg")
	  (if (/= (findfile bm) nil)
	    (command "insert" bm p1 "" "" "")
	  )
;;;end if
	  (setq	txt (nth 5 gcgkb)
		j   1
	  )
	  (while (and (<= j (strlen txt)) (/= (substr txt j 1) " "))
	    (setq j (1+ j))
	  )
	  (setq txt (substr txt 1 (1- j)))
	  (command "_.text" "s" "style1" "m" p2 0.23 0 txt)
	  (command "_.text"	 "s"	       "style1"
		   "ml"		 p3	       0.23
		   0		 "基点(场地基准座标点)"
		  )
	)
;;;end progn
	(setq i (1- i))
      )
;;;end if
      (if (/= pmxb2 nil)
	(progn
	  (setq p1 (list (+ (car p00) 30.5) (- y (* i 1) 1)))
	  (setq p2 (list (+ (car p00) 30.8) (- y (* i 1) 1)))
	  (setq p3 (list (+ (car p00) 31.5) (- y (* i 1) 1)))
	  (setq p4 (list (+ (car p00) 31.6) (- y (* i 1) 1)))
	  (setq p5 (list (+ (car p00) 32.5) (- y (* i 1) 1)))
	  (setq txt (car (car pmb)))
	  (command "_.text" "s" "style1" "ml" p1 0.23 0 txt)
	  (setq txt (strcat txt "'"))
	  (command "_.text" "s" "style1" "ml" p4 0.23 0 txt)
	  (command "_.text"	"s"	     "style1"	  "ml"
		   p5		0.23	     0
		   "工程地质剖面及编号"
		  )
	  (command "_.pline" p2 "w" 0.013 "" p3 "")
	)
;;;end progn
      )
;;;end if  
      (command "zoom" "w" p00 p01)
      (command)

      (setq gcml (nth 30 gcwzb))
      (setq gcmc (nth 0 gcgkb))
      (setq txt1 (strcat gcml gcmc "-" "钻孔平面布置图"))

      (setq txt1
	     (strcat
	       "c:/Gees/岩土工程勘察专家系统/gcrtf/"
	       "钻孔平面布置图"
	     )
      )

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

    )
;;;;;endprogn A3

  )
;;;;;;;END IF




)
;;;end defun







(defun c:z1 ()
  (setq zzth 1)
  (command "_.zoom" "e")
  (command "_.erase" "all" "" "")
  (command)
  (command "_.zoom" "w" "0,0" "38,26")
  (apply 'previewzzt ())
)
;;end z1

(defun c:z2 ()
  (setq zzth 2)
  (command "_.zoom" "e")
  (command "_.erase" "all" "" "")
  (command)
  (command "_.zoom" "w" "0,0" "38,26")
  (apply 'previewzzt ())
)
;;end z1

(defun c:z3 ()
  (setq zzth 3)
  (command "_.zoom" "e")
  (command "_.erase" "all" "" "")
  (command)
  (command "_.zoom" "w" "0,0" "38,26")
  (apply 'previewzzt ())
)
;;end z1

(defun c:z4 ()
  (setq zzth 4)
  (command "_.zoom" "e")
  (command "_.erase" "all" "" "")
  (command)
  (command "_.zoom" "w" "0,0" "38,26")
  (apply 'previewzzt ())
)
;;end z1

(defun c:z5 ()
  (setq zzth 5)
  (command "_.zoom" "e")
  (command "_.erase" "all" "" "")
  (command)
  (command "_.zoom" "w" "0,0" "38,26")
  (apply 'previewzzt ())
)
;;end z1

(defun c:z6 ()
  (setq zzth 6)
  (command "_.zoom" "e")
  (command "_.erase" "all" "" "")
  (command)
  (command "_.zoom" "w" "0,0" "38,26")
  (apply 'previewzzt ())
)
;;end z1

(defun c:z7 ()
  (setq zzth 7)
  (command "_.zoom" "e")
  (command "_.erase" "all" "" "")
  (command)
  (command "_.zoom" "w" "0,0" "38,26")
  (apply 'previewzzt ())
)
;;end z1

(defun c:z8 ()
  (setq zzth 8)
  (command "_.zoom" "e")
  (command "_.erase" "all" "" "")
  (command)
  (command "_.zoom" "w" "0,0" "38,26")
  (apply 'previewzzt ())
)
;;end z1

(defun c:z9 ()
  (setq zzth 9)
  (command "_.zoom" "e")
  (command "_.erase" "all" "" "")
  (command)
  (command "_.zoom" "w" "0,0" "38,26")
  (apply 'previewzzt ())
)
;;end z1

(defun c:z10 ()
  (setq zzth 10)
  (command "_.zoom" "e")
  (command "_.erase" "all" "" "")
  (command)
  (command "_.zoom" "w" "0,0" "38,26")
  (apply 'previewzzt ())
)
;;end z1




(defun c:z11 ()
  (setq zzth 11)
  (command "_.zoom" "e")
  (command "_.erase" "all" "" "")
  (command)
  (command "_.zoom" "w" "0,0" "38,26")
  (apply 'previewzzt ())
)
;;end z1

(defun c:z12 ()
  (setq zzth 12)
  (command "_.zoom" "e")
  (command "_.erase" "all" "" "")
  (command)
  (command "_.zoom" "w" "0,0" "38,26")
  (apply 'previewzzt ())
)
;;end z1

(defun c:z13 ()
  (setq zzth 13)
  (command "_.zoom" "e")
  (command "_.erase" "all" "" "")
  (command)
  (command "_.zoom" "w" "0,0" "38,26")
  (apply 'previewzzt ())
)
;;end z1

(defun c:z14 ()
  (setq zzth 14)
  (command "_.zoom" "e")
  (command "_.erase" "all" "" "")
  (command)
  (command "_.zoom" "w" "0,0" "38,26")
  (apply 'previewzzt ())
)
;;end z1

(defun c:z15 ()
  (setq zzth 15)
  (command "_.zoom" "e")
  (command "_.erase" "all" "" "")
  (command)
  (command "_.zoom" "w" "0,0" "38,26")
  (apply 'previewzzt ())
)
;;end z1

(defun c:z16 ()
  (setq zzth 16)
  (command "_.zoom" "e")
  (command "_.erase" "all" "" "")
  (command)
  (command "_.zoom" "w" "0,0" "38,26")
  (apply 'previewzzt ())
)
;;end z1

(defun c:z17 ()
  (setq zzth 17)
  (command "_.zoom" "e")
  (command "_.erase" "all" "" "")
  (command)
  (command "_.zoom" "w" "0,0" "38,26")
  (apply 'previewzzt ())
)
;;end z1

(defun c:z18 ()
  (setq zzth 18)
  (command "_.zoom" "e")
  (command "_.erase" "all" "" "")
  (command)
  (command "_.zoom" "w" "0,0" "38,26")
  (apply 'previewzzt ())
)
;;end z1

(defun c:z19 ()
  (setq zzth 19)
  (command "_.zoom" "e")
  (command "_.erase" "c" "-1000,-1000" "1000,1000" "")
  (command "_.zoom" "w" "0,0" "38,26")
  (apply 'previewzzt ())
)
;;end z1

(defun c:z20 ()
  (setq zzth 20)
  (command "_.zoom" "e")
  (command "_.erase" "c" "-1000,-1000" "1000,1000" "")
  (command "_.zoom" "w" "0,0" "38,26")
  (apply 'previewzzt ())
)
;;end z1



(defun c:z21 ()
  (setq zzth 21)
  (command "_.zoom" "e")
  (command "_.erase" "c" "-1000,-1000" "1000,1000" "")
  (command "_.zoom" "w" "0,0" "38,26")
  (apply 'previewzzt ())
)
;;end z1

(defun c:z22 ()
  (setq zzth 22)
  (command "_.zoom" "e")
  (command "_.erase" "c" "-1000,-1000" "1000,1000" "")
  (command "_.zoom" "w" "0,0" "38,26")
  (apply 'previewzzt ())
)
;;end z1

(defun c:z23 ()
  (setq zzth 23)
  (command "_.zoom" "e")
  (command "_.erase" "c" "-1000,-1000" "1000,1000" "")
  (command "_.zoom" "w" "0,0" "38,26")
  (apply 'previewzzt ())
)
;;end z1

(defun c:z24 ()
  (setq zzth 24)
  (command "_.zoom" "e")
  (command "_.erase" "c" "-1000,-1000" "1000,1000" "")
  (command "_.zoom" "w" "0,0" "38,26")
  (apply 'previewzzt ())
)
;;end z1

(defun c:z25 ()
  (setq zzth 25)
  (command "_.zoom" "e")
  (command "_.erase" "c" "-1000,-1000" "1000,1000" "")
  (command "_.zoom" "w" "0,0" "38,26")
  (apply 'previewzzt ())
)
;;end z1

(defun c:z26 ()
  (setq zzth 26)
  (command "_.zoom" "e")
  (command "_.erase" "c" "-1000,-1000" "1000,1000" "")
  (command "_.zoom" "w" "0,0" "38,26")
  (apply 'previewzzt ())
)
;;end z1

(defun c:z27 ()
  (setq zzth 27)
  (command "_.zoom" "e")
  (command "_.erase" "c" "-1000,-1000" "1000,1000" "")
  (command "_.zoom" "w" "0,0" "38,26")
  (apply 'previewzzt ())
)
;;end z1

(defun c:z28 ()
  (setq zzth 28)
  (command "_.zoom" "e")
  (command "_.erase" "c" "-1000,-1000" "1000,1000" "")
  (command "_.zoom" "w" "0,0" "38,26")
  (apply 'previewzzt ())
)
;;end z1

(defun c:z29 ()
  (setq zzth 29)
  (command "_.zoom" "e")
  (command "_.erase" "c" "-1000,-1000" "1000,1000" "")
  (command "_.zoom" "w" "0,0" "38,26")
  (apply 'previewzzt ())
)
;;end z1

(defun c:z30 ()
  (setq zzth 30)
  (command "_.zoom" "e")
  (command "_.erase" "c" "-1000,-1000" "1000,1000" "")
  (command "_.zoom" "w" "0,0" "38,26")
  (apply 'previewzzt ())
)
;;end z1



(defun c:z31 ()
  (setq zzth 31)
  (command "_.zoom" "e")
  (command "_.erase" "c" "-1000,-1000" "1000,1000" "")
  (command "_.zoom" "w" "0,0" "38,26")
  (apply 'previewzzt ())
)
;;end z1

(defun c:z32 ()
  (setq zzth 32)
  (command "_.zoom" "e")
  (command "_.erase" "c" "-1000,-1000" "1000,1000" "")
  (command "_.zoom" "w" "0,0" "38,26")
  (apply 'previewzzt ())
)
;;end z1

(defun c:z33 ()
  (setq zzth 33)
  (command "_.zoom" "e")
  (command "_.erase" "c" "-1000,-1000" "1000,1000" "")
  (command "_.zoom" "w" "0,0" "38,26")
  (apply 'previewzzt ())
)
;;end z1

(defun c:z34 ()
  (setq zzth 34)
  (command "_.zoom" "e")
  (command "_.erase" "c" "-1000,-1000" "1000,1000" "")
  (command "_.zoom" "w" "0,0" "38,26")
  (apply 'previewzzt ())
)
;;end z1

(defun c:z35 ()
  (setq zzth 35)
  (command "_.zoom" "e")
  (command "_.erase" "c" "-1000,-1000" "1000,1000" "")
  (command "_.zoom" "w" "0,0" "38,26")
  (apply 'previewzzt ())
)
;;end z1

(defun c:z36 ()
  (setq zzth 36)
  (command "_.zoom" "e")
  (command "_.erase" "c" "-1000,-1000" "1000,1000" "")
  (command "_.zoom" "w" "0,0" "38,26")
  (apply 'previewzzt ())
)
;;end z1

(defun c:z37 ()
  (setq zzth 37)
  (command "_.zoom" "e")
  (command "_.erase" "c" "-1000,-1000" "1000,1000" "")
  (command "_.zoom" "w" "0,0" "38,26")
  (apply 'previewzzt ())
)
;;end z1

(defun c:z38 ()
  (setq zzth 38)
  (command "_.zoom" "e")
  (command "_.erase" "c" "-1000,-1000" "1000,1000" "")
  (command "_.zoom" "w" "0,0" "38,26")
  (apply 'previewzzt ())
)
;;end z1

(defun c:z39 ()
  (setq zzth 39)
  (command "_.zoom" "e")
  (command "_.erase" "c" "-1000,-1000" "1000,1000" "")
  (command "_.zoom" "w" "0,0" "38,26")
  (apply 'previewzzt ())
)
;;end z1

(defun c:z40 ()
  (setq zzth 40)
  (command "_.zoom" "e")
  (command "_.erase" "c" "-1000,-1000" "1000,1000" "")
  (command "_.zoom" "w" "0,0" "38,26")
  (apply 'previewzzt ())
)
;;end z1



(defun c:z41 ()
  (setq zzth 41)
  (command "_.zoom" "e")
  (command "_.erase" "c" "-1000,-1000" "1000,1000" "")
  (command "_.zoom" "w" "0,0" "38,26")
  (apply 'previewzzt ())
)
;;end z1

(defun c:z42 ()
  (setq zzth 42)
  (command "_.zoom" "e")
  (command "_.erase" "c" "-1000,-1000" "1000,1000" "")
  (command "_.zoom" "w" "0,0" "38,26")
  (apply 'previewzzt ())
)
;;end z1

(defun c:z43 ()
  (setq zzth 43)
  (command "_.zoom" "e")
  (command "_.erase" "c" "-1000,-1000" "1000,1000" "")
  (command "_.zoom" "w" "0,0" "38,26")
  (apply 'previewzzt ())
)
;;end z1

(defun c:z44 ()
  (setq zzth 44)
  (command "_.zoom" "e")
  (command "_.erase" "c" "-1000,-1000" "1000,1000" "")
  (command "_.zoom" "w" "0,0" "38,26")
  (apply 'previewzzt ())
)
;;end z1

(defun c:z45 ()
  (setq zzth 45)
  (command "_.zoom" "e")
  (command "_.erase" "c" "-1000,-1000" "1000,1000" "")
  (command "_.zoom" "w" "0,0" "38,26")
  (apply 'previewzzt ())
)
;;end z1

(defun c:z46 ()
  (setq zzth 46)
  (command "_.zoom" "e")
  (command "_.erase" "c" "-1000,-1000" "1000,1000" "")
  (command "_.zoom" "w" "0,0" "38,26")
  (apply 'previewzzt ())
)
;;end z1

(defun c:z47 ()
  (setq zzth 47)
  (command "_.zoom" "e")
  (command "_.erase" "c" "-1000,-1000" "1000,1000" "")
  (command "_.zoom" "w" "0,0" "38,26")
  (apply 'previewzzt ())
)
;;end z1

(defun c:z48 ()
  (setq zzth 48)
  (command "_.zoom" "e")
  (command "_.erase" "c" "-1000,-1000" "1000,1000" "")
  (command "_.zoom" "w" "0,0" "38,26")
  (apply 'previewzzt ())
)
;;end z1

(defun c:z49 ()
  (setq zzth 49)
  (command "_.zoom" "e")
  (command "_.erase" "c" "-1000,-1000" "1000,1000" "")
  (command "_.zoom" "w" "0,0" "38,26")
  (apply 'previewzzt ())
)
;;end z1

(defun c:z50 ()
  (setq zzth 50)
  (command "_.zoom" "e")
  (command "_.erase" "c" "-1000,-1000" "1000,1000" "")
  (command "_.zoom" "w" "0,0" "38,26")
  (apply 'previewzzt ())
)
;;end z1


(defun c:z0 ()
  (setq zzth (getint "请输入柱状图页码号："))
  (command "_.zoom" "e")
  (command "_.erase" "c" "-1000,-1000" "1000,1000" "")
  (command "_.zoom" "w" "0,0" "38,26")
  (apply 'previewzzt ())
)
;;end z1

(defun c:n ()
  (if (/= zzth 10000)
    (progn
      (setq zzth (1+ zzth))
      (command "_.zoom" "e")
      (command "_.erase" "c" "-1000,-1000" "1000,1000" "")
      (command "_.zoom" "w" "0,0" "38,26")
      (apply 'previewzzt ())
    )
;;;endprogn
    (progn
      (setq pmh (1+ pmh))
      (command "_.zoom" "e")
      (command "_.erase" "all" "" "")
      (command)
      (command "_.zoom" "w" "-5,-26" "33,6")
      (apply 'pmtprint ())

    )
;;;;endprogn

  )
;;;endif
)
;;end z1

(defun c:l ()
  (if (/= zzth 10000)
    (progn
      (setq zzth (1- zzth))
      (command "_.zoom" "e")
      (command "_.erase" "c" "-1000,-1000" "1000,1000" "")
      (command "_.zoom" "w" "0,0" "38,26")
      (apply 'previewzzt ())
    )
;;;endprogn
    (progn
      (setq pmh (1- pmh))
      (command "_.zoom" "e")
      (command "_.erase" "all" "" "")
      (command)
      (command "_.zoom" "w" "-5,-26" "33,6")
      (apply 'pmtprint ())

    )
;;;endprogn
  )
;;;endif
)
;;end z1
(defun oo ()
  (setq p1 (list (- (car p001) 0.2) (- (cadr p001) 0.2)))
  (setq p2 (list (+ (car p002) 0.2) (+ (cadr p002) 0.2)))
  (setq	l1 (- (car p2) (car p1) -2)
	l2 (- (cadr p2) (cadr p1) -2)
  )
  (setq	pagesize (strcat "最小纸张  长："
			 (rtos l1)
			 "cm、"
			 "宽："
			 (rtos l2)
			 "cm。 OK?"
		 )
  )
  (setq pagesize (getstring pagesize))

  (command "_.zoom" "e")
  (cond
    ((= plotstyle "pmtA4")
     (command "plot" "e" 5 "n" "" "" ""	"n" "n"	"m" "10,10" "A3" 90 "n"
	      10 0)
    )
    ((= plotstyle "zztA4")
     (command "plot" "e" 5 "n" "" "" ""	"n" "n"	"m" "20,10" "A3" 0 "n"
	      10 0)
    )
    ((= plotstyle "other")
     (command "plot" "e" 5 "n" "" "" ""	"n" "n"	"m" "20,10" "A3" 0 "n"
	      10 0)
    )
  )
;;;end cond
)
;;end p()


(defun c:a ()
  (if (/= zzth 10000)
    (progn
      (setq zzth (1+ zzth))
      (command "_.zoom" "e")
      (command "_.erase" "c" "-1000,-1000" "1000,1000" "")
      (command "_.zoom" "w" "0,0" "38,26")
      (apply 'previewzzt ())
      (apply 'oo ())
    )
;;;endprogn

    (progn
      (setq pmh (1+ pmh))
      (command "_.zoom" "e")
      (command "_.erase" "all" "" "")
      (command)
      (command "_.zoom" "w" "-5,-26" "33,6")
      (apply 'pmtprint ())
      (apply 'oo ())
    )
;;;endprogn

  )
;;;endif 
)
;;end z1










(defun c:p1 ()
  (setq pmh 1)
  (command "_.zoom" "e")
  (command "_.erase" "all" "" "")
  (command)
  (command "_.zoom" "w" "-5,-26" "33,6")
  (apply 'pmtprint ())
)

(defun c:p2 ()
  (setq pmh 2)
  (command "_.zoom" "e")
  (command "_.erase" "all" "" "")
  (command)
  (command "_.zoom" "w" "-5,-26" "33,6")
  (apply 'pmtprint ())
)


(defun c:p3 ()
  (setq pmh 3)
  (command "_.zoom" "e")
  (command "_.erase" "all" "" "")
  (command)
  (command "_.zoom" "w" "-5,-26" "33,6")
  (apply 'pmtprint ())
)


(defun c:p4 ()
  (setq pmh 4)
  (command "_.zoom" "e")
  (command "_.erase" "all" "" "")
  (command)
  (command "_.zoom" "w" "-5,-26" "33,6")
  (apply 'pmtprint ())
)


(defun c:p5 ()
  (setq pmh 5)
  (command "_.zoom" "e")
  (command "_.erase" "all" "" "")
  (command)
  (command "_.zoom" "w" "-5,-26" "33,6")
  (apply 'pmtprint ())
)


(defun c:p6 ()
  (setq pmh 6)
  (command "_.zoom" "e")
  (command "_.erase" "all" "" "")
  (command)
  (command "_.zoom" "w" "-5,-26" "33,6")
  (apply 'pmtprint ())
)


(defun c:p7 ()
  (setq pmh 7)
  (command "_.zoom" "e")
  (command "_.erase" "all" "" "")
  (command)
  (command "_.zoom" "w" "-5,-26" "33,6")
  (apply 'pmtprint ())
)


(defun c:p8 ()
  (setq pmh 8)
  (command "_.zoom" "e")
  (command "_.erase" "all" "" "")
  (command)
  (command "_.zoom" "w" "-5,-26" "33,6")
  (apply 'pmtprint ())
)


(defun c:p9 ()
  (setq pmh 9)
  (command "_.zoom" "e")
  (command "_.erase" "all" "" "")
  (command)
  (command "_.zoom" "w" "-5,-26" "33,6")
  (apply 'pmtprint ())
)


(defun c:p10 ()
  (setq pmh 10)
  (command "_.zoom" "e")
  (command "_.erase" "all" "" "")
  (command)
  (command "_.zoom" "w" "-5,-26" "33,6")
  (apply 'pmtprint ())
)


(defun c:p11 ()
  (setq pmh 11)
  (command "_.zoom" "e")
  (command "_.erase" "all" "" "")
  (command)
  (command "_.zoom" "w" "-5,-26" "33,6")
  (apply 'pmtprint ())
)


(defun c:p12 ()
  (setq pmh 12)
  (command "_.zoom" "e")
  (command "_.erase" "all" "" "")
  (command)
  (command "_.zoom" "w" "-5,-26" "33,6")
  (apply 'pmtprint ())
)


(defun c:p13 ()
  (setq pmh 13)
  (command "_.zoom" "e")
  (command "_.erase" "all" "" "")
  (command)
  (command "_.zoom" "w" "-5,-26" "33,6")
  (apply 'pmtprint ())
)


(defun c:p14 ()
  (setq pmh 14)
  (command "_.zoom" "e")
  (command "_.erase" "all" "" "")
  (command)
  (command "_.zoom" "w" "-5,-26" "33,6")
  (apply 'pmtprint ())
)


(defun c:p15 ()
  (setq pmh 15)
  (command "_.zoom" "e")
  (command "_.erase" "all" "" "")
  (command)
  (command "_.zoom" "w" "-5,-26" "33,6")
  (apply 'pmtprint ())
)


(defun c:p16 ()
  (setq pmh 16)
  (command "_.zoom" "e")
  (command "_.erase" "all" "" "")
  (command)
  (command "_.zoom" "w" "-5,-26" "33,6")
  (apply 'pmtprint ())
)


(defun c:p17 ()
  (setq pmh 17)
  (command "_.zoom" "e")
  (command "_.erase" "all" "" "")
  (command)
  (command "_.zoom" "w" "-5,-26" "33,6")
  (apply 'pmtprint ())
)


(defun c:p18 ()
  (setq pmh 18)
  (command "_.zoom" "e")
  (command "_.erase" "all" "" "")
  (command)
  (command "_.zoom" "w" "-5,-26" "33,6")
  (apply 'pmtprint ())
)


(defun c:p19 ()
  (setq pmh 19)
  (command "_.zoom" "e")
  (command "_.erase" "all" "" "")
  (command)
  (command "_.zoom" "w" "-5,-26" "33,6")
  (apply 'pmtprint ())
)


(defun c:p20 ()
  (setq pmh 20)
  (command "_.zoom" "e")
  (command "_.erase" "all" "" "")
  (command)
  (command "_.zoom" "w" "-5,-26" "33,6")
  (apply 'pmtprint ())
)


(defun c:p21 ()
  (setq pmh 21)
  (command "_.zoom" "e")
  (command "_.erase" "all" "" "")
  (command)
  (command "_.zoom" "w" "-5,-26" "33,6")
  (apply 'pmtprint ())
)


(defun c:p22 ()
  (setq pmh 22)
  (command "_.zoom" "e")
  (command "_.erase" "all" "" "")
  (command)
  (command "_.zoom" "w" "-5,-26" "33,6")
  (apply 'pmtprint ())
)


(defun c:p23 ()
  (setq pmh 23)
  (command "_.zoom" "e")
  (command "_.erase" "all" "" "")
  (command)
  (command "_.zoom" "w" "-5,-26" "33,6")
  (apply 'pmtprint ())
)


(defun c:p24 ()
  (setq pmh 24)
  (command "_.zoom" "e")
  (command "_.erase" "all" "" "")
  (command)
  (command "_.zoom" "w" "-5,-26" "33,6")
  (apply 'pmtprint ())
)


(defun c:p25 ()
  (setq pmh 25)
  (command "_.zoom" "e")
  (command "_.erase" "all" "" "")
  (command)
  (command "_.zoom" "w" "-5,-26" "33,6")
  (apply 'pmtprint ())
)


(defun c:p26 ()
  (setq pmh 26)
  (command "_.zoom" "e")
  (command "_.erase" "all" "" "")
  (command)
  (command "_.zoom" "w" "-5,-26" "33,6")
  (apply 'pmtprint ())
)


(defun c:p27 ()
  (setq pmh 27)
  (command "_.zoom" "e")
  (command "_.erase" "all" "" "")
  (command)
  (command "_.zoom" "w" "-5,-26" "33,6")
  (apply 'pmtprint ())
)


(defun c:p28 ()
  (setq pmh 28)
  (command "_.zoom" "e")
  (command "_.erase" "all" "" "")
  (command)
  (command "_.zoom" "w" "-5,-26" "33,6")
  (apply 'pmtprint ())
)


(defun c:p29 ()
  (setq pmh 29)
  (command "_.zoom" "e")
  (command "_.erase" "all" "" "")
  (command)
  (command "_.zoom" "w" "-5,-26" "33,6")
  (apply 'pmtprint ())
)


(defun c:p30 ()
  (setq pmh 30)
  (command "_.zoom" "e")
  (command "_.erase" "all" "" "")
  (command)
  (command "_.zoom" "w" "-5,-26" "33,6")
  (apply 'pmtprint ())
)

(defun c:p0 ()
  (setq pmh (getint "请输入剖面号(整数)："))
  (command "_.zoom" "e")
  (command "_.erase" "all" "" "")
  (command)
  (command "_.zoom" "w" "-5,-26" "33,6")
  (apply 'pmtprint ())
)




