;;;------------------------------
;;; 1998.01.11 thu
;;; 标注点标高 @bzbg.lsp
;;;------------------------------
(defun t_bgbz(/ laypt lay ss)
  
  (HY_Set0)
  (undo_m)
  (setq laypt "PP-TF-PT")
  (setq lay "PP-TF-BGBZ")
  (DL_MakeLayer lay)
  (if (/= (DL_TFBGBZ_SET) nil)
	(progn
	  (prompt "\n选择范围:")
	  (setq ss (ssget (list (cons -4 "<or")
	                        (cons -4 "<and")
	                        (cons 0 "POINT") (cons 8 laypt) 
	                        (cons -4 "and>")
	                        (cons -4 "<and")
	                        (cons 0 "TEXT") (cons 8 lay)
	                        (cons -4 "and>")
	                        (cons -4 "or>")
	  )))
	  (BG_dim ss)
	)
  )
  
  (HY_RV)
  
)

(defun BG_dim( ss  /  lay hh ww sca ii e eb pt bg zrbg sjbg elev 
                ssp sst lx p01 p02 p03 )
(if ss
    (progn
      (if (null TF::ZRBG_DIM) (setq TF::ZRBG_DIM  1))
      (if (null TF::SJBG_DIM) (setq TF::SJBG_DIM  1))
      (if (null TF::GC_DIM) (setq TF::GC_DIM  1))
      (setq lay "PP-TF-BGBZ")
      (DL_MakeLayer lay)
      (setq hh (/ (Dl_GetTextHeight) (DL_GetDrawingFactor)))    ;*** text high
      (setq ww (DL_GetDimPrec))  ;*** 小数位数 ***
      (setq sst (ssadd) ssp (ssadd))
      (setq ii 0)
      (repeat (sslength ss)
        (setq e (ssname ss ii)
              eb (entget e)
              lx (cdr (assoc 0 eb))
        )
        (if (= lx "TEXT")
          (setq sst (ssadd e sst))
          (setq ssp (ssadd e ssp))
        )
        (setq ii (1+ ii))
      )
      (if (> (sslength sst) 0) (command "erase" sst ""))
      (if (> (sslength ssp) 0)
        (progn
          (setq ii 0)
          (repeat (sslength ssp)
            (setq e (ssname ssp ii)
                  eb (entget e)
                  pt (cdr (assoc 10 eb))
                  zrbg (q1040 e "ZRBG")
              ;;;    zrbg (caddr pt)
                  sjbg (q1040 e "SJBG")
                  p01 (polar pt (*  0.25 pi) 1.0)
                  p02 (polar pt (* -0.25 pi) 1.0)
                  p03 (polar pt (*  0.75 pi) 1.0)
            )
            (if  zrbg
            
              (progn
                (if (<= zrbg 0.0) 
                  (setq zrbg (rtos zrbg 2 ww))
                  (setq zrbg (strcat "+" (rtos zrbg 2 ww)))
                )
                (if (= TF::ZRBG_DIM 1)
                    (command "text" "j" "tl" p02 hh 0.0 zrbg)
                )
              );;;progn
            );;;if
            
            (if  sjbg
              (progn
                (if zrbg (setq elev (- sjbg (atof zrbg))) (setq elev nil))
                (if (<= sjbg 0.0) 
                  (setq sjbg (rtos sjbg 2 ww))
                  (setq sjbg (strcat "+" (rtos sjbg 2 ww)))
                )
                (if (= TF::SJBG_DIM 1)
                   (command "text" "j" "bl" p01 hh 0.0 sjbg)
                )
                (if  elev
                   (progn
                      (if (<= elev 0.0) 
                        (setq elev (rtos elev 2 ww))
                        (setq elev (strcat "+" (rtos elev 2 ww)))
                      )
                      (if (= TF::GC_DIM 1)
                          (command "text" "j" "br" p03 hh 0.0 elev)
                      )
                    );;;progn
                );;;if
              )
            )
            (setq ii (1+ ii))
          )
          (prompt "\n网格交叉点的右下角为自然标高;右上角为设计标高;左上角为高程差。")
        )
      )
    )
  )
)

;;;------------------------------
;;; 1998.01.11 thu
;;; 土方标注
;;;------------------------------
(defun t_tfbz (/ lay hh sca ss ii e eb p00 p01 p02 tf wf ww SjyType ttt www)

  (HY_SV)
  (HY_UndoM)
  (setq lay "PP-TF-TFBZ")
  (setq laypt "PP-TF-PT")
  (DL_MakeLayer lay)
  (setq hh (/ (Dl_GetTextHeight) (DL_GetDrawingFactor)))	;*** text high
  (setq ww (DL_GetDimPrec))			;*** 小数位数 ***

  (prompt "请选择:")
  (setq	ss (ssget (list	(cons 0 "INSERT")
			(cons 2 "JSCKD")
			(cons 8 laypt)
			(list -3 '("JSCK"))
			(list -3 '("TF"))
			(list -3 '("WF"))
		  )
	   )
  )
  (if ss
    (progn
    	(setq SjyType (Dl_GetUserType))
    	(if(= SjyType 0)
				(progn
					(setq ttt "T=")
					(setq www "W=")
				)
				(progn
					(setq ttt "+")
					(setq www "-")
				)
			)
      (setq ii 0)
      (repeat (sslength ss)
	(setq e	  (ssname ss ii)
	      eb  (entget e)
	      p00 (cdr (assoc 10 eb))
	      tf  (q1040 e "TF")
	      wf  (q1040 e "WF")
	)
	(cond
	  ((and (> tf 1.0e-3) (< wf 1.0e-3)) ;*** 只填 ***			
	   (command "text"
		    "j"
		    "mc"
		    p00
		    hh
		    0.0
		    (strcat ttt (rtos tf 2 ww))
	   )
	  )
	  ((and (< tf 1.0e-3) (> wf 1.0e-3)) ;*** 只挖 ***
	   (command "text"
		    "j"
		    "mc"
		    p00
		    hh
		    0.0
		    (strcat www (rtos wf 2 ww))
	   )
	  )
	  (t
	   (setq tf (strcat ttt (rtos tf 2 ww)))
	   (setq wf (strcat www (rtos wf 2 ww)))
	   (setq p01 (polar p00 (* 0.5 pi) (* 0.1 hh))
		 p02 (polar p00 (* 1.5 pi) (* 0.1 hh))
	   )
	   (command "text" "j" "bc" p01 hh 0.0 tf)
	   (command "text" "j" "tc" p02 hh 0.0 wf)
	  )
	)
	(setq ii (1+ ii))
      )
      (prompt "\n可用Undo/Back命令取消上次操作.")
    )
  )
  (HY_RV)
)
;;;------------------------------
;;; 1998.01.11 thu
;;; 土方统计  tftj.lsp
;;;------------------------------
(defun t_tftj (/     lay   hh	 sca   ss    ii	   e	 eb    p00
	       wgbl  ptb   pmin	 pmax  laypt ft	   vv	 tf    wf
	       ttff  wwff  ptmp	 ww    laybj p01   p02	 
	       p06   p07   p10   p000	 p11 p12   
	       p15   p16   tab_mode  tf_data bp_data  ang1  ang2  ff
	       w_pt1 w_pt2 w_ptb  data  sub_list subBH lbpt  rupt dist_x dist_y
	      )
  (DL_arxload "earthwork")
  (HY_Set0)
  (HY_UndoM)
  (#ppls "HYSZDLSZ")
  (setq	lay   "PP-TF-TFBZ"
	laypt "PP-TF-PT"
	laybj "PP-TF-BJ"
  )
  (DL_MakeLayer lay)
  (setvar "cecolor" "7")

  (setq hh (/ (Dl_GetTextHeight) (DL_GetDrawingFactor)))	;*** text high
  (setq ww (DL_GetDimPrec))			;*** 小数位数 ***  
  (if (null tftj:mode)
    (setq tftj:mode "H");;;默认水平模式（旧的方式）
  )

  (setq ft t)
  (while ft
    (initget 6 "A X S")
   ;;;; (setq bh (getint "\n所有区域 A / 局部统计 X／ 统计设置 S／ 输入区域编号<1>:"))
    (if (= tftj:mode "H")
        (setq bh (getint "\n所有区域 A / 局部统计 X／ 统计设置 S(当前为水平方式)／ 输入区域编号<1>:"))
        (setq bh (getint "\n所有区域 A / 局部统计 X／ 统计设置 S(当前为竖直方式)／ 输入区域编号<1>:"))
    )
    (cond ((= bh "S")
           (initget "H V")
           (setq tab_mode
				(getkword (strcat "\n土方统计表布置方式： 水平方式 H ／ 竖直方式 V <" tftj:mode ">"))
			)
			(if tab_mode
				(setq tftj:mode tab_mode)
			)
        )
          ((= bh "X")
           (tftj_part)
           (setq ft   nil)
          )
          ((= bh "A")
           (progn
	     (setq ft  nil
	          wgbl nil
	          app  "A*"
	     )
	     (js_all)
           )
          )
          (t 
           (progn
            (if (= bh nil) (setq bh 1))
             (setq sub_list (get_sub_bh bh))
            (if sub_list (setq subBH (getint "\n 回车 统计当前区域 ／输入子编号区域:")))
            (if (and  subBH (member subBH sub_list))
                 (setq app (strcat "A" (itoa bh) "-" (itoa subBH)))
	     	 (setq app (strcat "A" (itoa bh)))
	    )

	   ;;; (setq app (strcat "A" (itoa bh)))
	    (if (not (setq fhb (qqwgin bh subBH)))
	    
	    (progn
	       (beep)
	       (prompt "\n该编号区域没有定义。")
	     )
	     (setq	ft   nil
		wgbl (nth 0 fhb)        ;---网格大小
		p00  (nth 1 fhb)	;--- insert point
		p000 (nth 2 fhb)	;--- origin point
		pmin (nth 3 fhb)        ;---本区域最小坐标
		pmax (nth 4 fhb)        ;---本区域最大坐标
	     )
	    );;;if
           );;;progn
          );;;t
   );;;cond
  );;;while

					;++++++++++++++++++++++++++++++++++++++++++++++++++++++++        
  (if wgbl
    (progn
      (initget 1)
      (setq ff nil)
      (while (null ff)
         (setq ptmp (getpoint "\n统计表格位置(在土方边界的外部点取):"))
         (if (= tftj:mode "H")
             (progn;;;横排
             	 (if (> (cadr ptmp) (cadr pmax))
             	     (setq ff "U");;;表格在上侧
             	     (if (< (cadr ptmp) (cadr pmin))
             	         (setq ff "D");;;表格在下侧
   	                 (prompt "统计表格的位置点必须在土方边界的外部")
   	             )
             	 )
              )
              (progn;;;竖排
             	 (if  (> (car ptmp) (car pmax))
             	     (setq ff "R")
             	     (if (< (car ptmp) (car pmin))
             	         (setq ff "L")
             	         (prompt "统计表格的位置点必须在土方边界的外部")
             	     )
             	 )
              )
          )
       )
              	
   ;;;(zoome)
    ;;;(zoomex)
    ;;将视区在土方边界上外扩土方区域的对角线长度
     (setq dist_x (- (car pmax)(car pmin)))
     (setq dist_y (- (cadr pmax) (cadr pmin)))
     (setq lbpt (list (- (car pmin) dist_x) (- (cadr pmin) dist_y) 0.0))
     (setq rupt (list (+ (car pmax) dist_x) (+ (cadr pmax) dist_y) 0.0))
     (command "zoom" "w" lbpt rupt)
     
      ;;(command "zoom" "w" pmin pmax "")
      (setq data (tfjs_tjb ff p000 wgbl pmin pmax ptmp app))
      (if data (setq p000 (nth 0 data) tf_data (nth 1 data) bp_data (nth 2 data))) 
      (if (or tf_data bp_data)
          (draw_tjb  ff p000 wgbl tf_data bp_data)
          (prompt "\n可用Undo/Back命令取消上次操作.")
      )
      (zoomex) 
    )
  )
					;++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  (HY_RV)
  (DL_arxunload "earthwork")
)
;;------------------------------
;; 取area info.
;; ==>(bl insert_point origin_point pmin pmax)
;;------------------------------
(defun qqwgin (bh subBH / ss ii e h b fhb p0 ptb)
  (setq ss (ssget "x" (list '(0 . "INSERT") '(-3 ("WGBH")))))
  (if ss
    (progn
      (setq ii 0)
      (repeat (sslength ss)
	(setq e	  (ssname ss ii)
	      p0  (cdr (assoc 10 (entget e)))
	      h	  (HY_QQ10xx e "WGBH" 1070)
	      s_h (HY_QQ10xx e "SUB" 1070)
	      b	  (HY_QQ10xx e "WGBH" 1040)
	      ptb (qxdata e "WGBH")
	      ii  (1+ ii)
	)
	(if (and (= bh h) (= subBH s_h))
	   (setq fhb (cons b (cons p0 (cons (HY_QQ10xx e "WGBH" 1010) ptb))))
	)
      )
    )
  )
  fhb
)
;;-------------------------------
(defun js_all (/ ss ii e tf wf wwff ttff wc)

  (setq	ss (ssget "x"
		  (list	(cons 0 "INSERT")
			(cons 2 "JSCKD")
			(cons 8 laypt)
			(list -3 (list app))
			(list -3 '("TF"))
			(list -3 '("WF"))
		  )
	   )
  )
  (if ss
    (progn
      (setq ii 0)
      (setq wwff 0.0
	    ttff 0.0
      )
      (repeat (sslength ss)
					(setq e	   (ssname ss ii)
					      tf   (HY_QQ10xx e "TF" 1040)
					      wf   (HY_QQ10xx e "WF" 1040)
					      wwff (+ wwff wf)
					      ttff (+ ttff tf)
					      ii   (1+ ii)
					)
      )
      (setq wc (abs (/ (* 100 (- wwff ttff)) (+ wwff ttff))))
      (prompt (strcat "\n总挖方(立方米) : " (rtos wwff)))
      (prompt (strcat "\n总填方(立方米) : " (rtos ttff)))
      (prompt (strcat "\n挖填差(  %   ) : " (rtos wc)))
    )
    (prompt "\n没有算土方.")
  )
)
(princ)


(defun tftj_part ( / w_ptb w_pt1 w_pt2 w_pt w_blkn w_cur_path w_ss ent fhb p000
                         ptb  xx yy  p0 tscaleOLD app1 app i len pt ptmp pmin
                         pmax pp eBJ e  eOldBj subBH  bh subBH_ins ehand wgbl
                         dist ff data bp_data tf_data flag)
  (#ppls "pppp")
  (setq ltscale (getvar "ltscale"))
  (command ".ltscale" 0.0001)
  (setq w_ptb nil)
  (DL_MakeLayer "PP-TF-PT")
  (setq flag t)
  (while flag 
  (initget "R")
  (setq w_pt1 (getpoint "\n回车退出 / 任意多边形R / 矩形区域第一点:"))
  (setq w_ptb nil)
  (cond
    ;;回车退出
    ((null w_pt1) 
     (setq flag nil)
    )
    ;;矩形区域
    ((listp w_pt1)
      (setq w_pt2 (getcorner w_pt1 "矩形区域第第二点:"))
      (if w_pt2
        (setq w_ptb (cons w_pt1 w_ptb)
      	      w_pt  (list (car w_pt1) (cadr w_pt2) 0.0)
      	      w_ptb (cons w_pt w_ptb)
      	      w_ptb (cons w_pt2 w_ptb)
      	      w_pt  (list (car w_pt2) (cadr w_pt1) 0.0)
      	      w_ptb (cons w_pt w_ptb)
        )
      )
    )
    ;;任意多边形
    (t
      (setq w_pt1 (getpoint "\n回车退出 / 任意多边形区域第一点:"))
      (if w_pt1
        (setq w_ptb ($get_ptb w_pt1))
      )
    )
  )

  (sa_osmode)
  (setvar "osmode" 0)
  (if w_ptb
    (progn
    	(&view_ptb w_ptb)
    	(setq w_ss (ssget "CP" w_ptb
    	         (list	(cons 0 "INSERT")
			(cons 2 "JSCKD")
			(cons 8 laypt)
			(list -3 (list "A*"))
			(list -3 '("TF"))
			(list -3 '("WF"))
	          )
	       )
	)


      ;;;要保证所选中的网格都是一个区域的，所以进行如下判断。
      (if w_ss
	(progn
          (setq i 0)
          (setq app nil)
          (setq len (sslength w_ss))
          (while (< i len)
                  (setq ent (ssname w_ss i))
                  (setq app1 (caadr (assoc -3 (entget ent (list "A*")))))
                  
                  (if (null app) (setq app app1)
                                 (if (/= app app1) 
                                     (setq app nil
                                           i len
                                     )
                                     (setq i (1+ i))
                                 )
                  )
          )
	);;;progn
      )
      

      (if  (and app (not (setq fhb (qqwgin (atoi (substr app 2)) nil))))
	    (progn
	       (beep)
	       (setq app nil)
	       (prompt "\n该编号区域没有定义。")
	     )
	     (setq p000 (nth 2 fhb)
	           wgbl (nth 0 fhb)
	     )	
       )

      ;;一个被下面的HY_UndoB()取消了
      (if (null app) 
          (progn 
            (prompt "\n按区域统计不能统计不同边界内的土方区域!")
            (setq w_ss nil)
          )
          (progn
  	      (HY_UndoM)
	      (setq ptb (TF_GetSubArea w_ptb))
	      (if ptb (setq w_ptb ptb))
	      (setq w_ss (pmcutdwg_cut w_ptb (list "PP-TF-TFBZ" "PP-TF-BGBZ" "PP-TF-BJ" 
	                                            "PP-TF-BH" "TF-SUB-BH" "TF-SUB-BJ" "PP-COM")))
	      (if w_ss
		 (progn
	          ;;;提取当前工程目录
	          (setq w_cur_path (DL_GetCurPrjDir))
                  (if (null w_cur_path)
	           (progn
	             (setq w_cur_path (HY_getworkdir))
	             (if w_cur_path (setq w_cur_path(substr w_cur_path 1 (- (strlen w_cur_path) 2))))
	           )
	          )
	          ;;;创建临时目录
	      	  (HY_MkMDir (strcat w_cur_path "\\hysztemp"))
	      	  (setq w_blkn (strcat w_cur_path "\\hysztemp\\hyszjbqy.dwg"))
	      	  (if (findfile w_blkn)
	      	    (command "_.wblock" w_blkn "Y" "" (car w_ptb) w_ss "")
	      	    (command "_.wblock" w_blkn "" (car w_ptb) w_ss "")
	      	  )
	      	  (HY_UndoB)
			  (re_osmode)
	      	  (setq ptmp (getpoint "\n点取统计区域放置基点(点取一空白区域):"))
	         )
	      );;;if w_ss
	      
	      (if ptmp
	       (progn 	
	       	 (sa_osmode)
	         (setvar "osmode" 0)  
        	 (command "insert" (strcat "hyszjbqy=" w_blkn) ptmp 1.0 1.0 0.0)
        	 (command "_.explode" (entlast))
	      	  ;;;求出裁图点表的第一个点
	      	  (setq pt (car w_ptb))
	      	  ;;;求新形成土方区域的点表,并求出新区域中的最小和最大坐标
		  (setq ptb nil)
		  (setq xx (- (car ptmp) (car pt)) yy (- (cadr ptmp) (cadr pt)))
		  (setq i 0)
		  (setq len (length w_ptb))
		  (while (< i len)
		     (setq pt (nth i w_ptb))
		     (setq pt (list (+ (car pt) xx) (+ (cadr pt) yy) 0.0))
		     (setq ptb (cons pt ptb))
		     (if (= i 0)
		         (setq pmin pt
		               pmax pt
		         )
		         (progn
		            (if (> (car pmin) (car pt)) (setq pmin (list (car pt) (cadr pmin) 0.0)))
		            (if (> (cadr pmin) (cadr pt)) (setq pmin (list (car pmin) (cadr pt) 0.0)))
		            (if (< (car pmax) (car pt)) (setq pmax (list (car pt) (cadr pmax) 0.0)))
		            (if (< (cadr pmax) (cadr pt)) (setq pmax (list (car pmax) (cadr pt) 0.0)))
		         )
		      )
		      (setq i (1+ i))
		  )

		  ;;;求新土方块的网格基点
		  (setq p0 (list (+ (car p000) xx) (+ (cadr p000) yy) 0.0))
	          	          
                  ;;;绘制新土方边界．
	          (DL_MakeLayer "PP-TF-BJ")
	          (setq ptb (append ptb (list (car ptb))))
	          
	      	  (hy_entmakepline "PP-TF-BJ" ptb)
	      	  (setq eBJ (entlast));;;边界实体名

   
	          ;;;删除网格处理点
	          (&view_ptb ptb)
	          (setq ss (ssget "CP" ptb  (list (cons 0 "INSERT")
			                          (cons 2 "JSCKD")
			                          (cons 8 "PP-TF-PT")
	                                    )
	                   )
	          )
	          (if ss (command "erase" ss ""))
	          
	          ;;;求新区域的子边界符号，边界中心点，该区域在主边界区域中的位置和边界符号实体名，同时
	          ;;;求出在新边界中须增加的交点和交点标高列表
     	  　　　　(setq fhb (TF_CalNewJdBG w_ptb))
	      	  (if fhb
	      	      (setq bh  (car (nth 0 fhb))
	      	            eOldBj (cadr (nth 0 fhb));;;主区域中的子边界实体名
	      	            subBH (caddr (nth 0 fhb));;;子边界编号
	      	            subBH_ins (cadddr (nth 0 fhb));;;子边界的中心（以主区域中的坐标表示）
	      	            ptb2 (nth 1 fhb);;;新区域中须增加的角点和交点标高列表（以主区域中的坐标表示）
	      	       )
	      	  )

	      	  ;;;求裁出的网格线选择集，并延伸网格线实体到新边界上
	      	  (&view_ptb ptb)
	      	  (setq ss (ssget "CP" ptb (list (cons 0 "LINE") (cons 8 "PP-TF-WG"))))
	          (if ss
	            (progn 
	              ;; (TF_Ext_LocalWG eBJ  ss)
	               (setq len (sslength ss))
	               (setq i 0)
	               (while (< i len)
	                 (setq e (ssname ss i))
                         (delkzsj e app)
  　　　　　　　　　　    (HY_KZSJXZ e (strcat app "-" (itoa subBH)) 1000 "@")
                         (setq i (1+ i))
	               )
	            )
	          )
	          (setq ss nil)
      	  
	      	  ;;;选择网格角点
	      	  (setq New_Pt_SS (ssadd));;;新网格区域的网格角点选择集
	      	  (&view_ptb ptb)
	          (setq ss (ssget "CP" ptb  (list (cons 0 "POINT")
			                          (cons 8 "PP-TF-PT")
		                            )
	                   )
	          )
	          
	          

	      	  ;;;将须增加的交点转换到新区域中，并绘制点，写扩展数据（这些点均为边界外的点）
	      	  (DL_MakeLayer "PP-TF-PT")
	      	  (if ptb2 
      	             (foreach fhb ptb2
	      	        (setq pp (list (+ (car (nth 0 fhb)) xx) (+  (cadr (nth 0 fhb)) yy) (caddr (nth 0 fhb))))
	      	        (if ss 
	      	           (progn
	      	             (setq i 0)
	      	             (setq len (sslength ss))
	      	             (while (< i len)
	      	             　 (setq e (ssname ss i))
	      	                (setq pt (cdr (assoc 10 (entget e))))
	      	                (if (<= (HY_PtPmDist pp pt) 0.01);;;若两点相等,原来的裁出点将变为新的边界点，应删除
	      	                   (progn
	      	                   　(ssdel e ss)
	      	                     (setq len (sslength ss))
	      	                     (entdel e)
	      	                     (setq i len)
	      	                   )
	      	                   (setq i (1+ i))
	      	                )
 	      	             )
	      	           )
	      	        )
	      	        ;;;该点的Z值等于自然标高
	      	        (if (/= (nth 1 fhb) 9999.0)
	      	            (setq pp (list (car pp) (cadr pp) (nth 1 fhb)))
	      	            (setq pp (list (car pp) (cadr pp) 0.0))
	      	        )

      	                (command "point" pp)
	      	        (setq e (entlast))
	      	        (if (/= (nth 1 fhb) 9999.0) (HY_KZSJXZ e "ZRBG" 1040 (nth 1 fhb)));;角点自然标高扩展数据
	      	        (if (/= (nth 2 fhb) 9999.0) (HY_KZSJXZ e "SJBG" 1040 (nth 2 fhb)));;角点设计标高扩展数据
	      	        (if (and (nth 1 fhb) (nth 2 fhb))
	      	            (command "change" e "" "p" "c" "red" "")
	      	            (if (nth 1 fhb)
	      	                (command "change" e "" "p" "c" "yellow" "")
	      	                (if (nth 2 fhb)
	      	                    (command "change" e "" "p" "c" "blue" "")
	      	                )
	      	            )
	      	        )
	      	            
	      	        (HY_KZSJXZ e (strcat app "-" (itoa subBH)) 1040 0.25 1070 0)  
	      	        (setq New_Pt_SS (ssadd e New_Pt_SS))
	      	     )
	      	  )
	      	  
	      	  ;;;修改网格内角点的附加数据，删除老的附加数据，重写新的附加数据
	          (if ss 
	           (progn
	          　(setq len (sslength ss))
	            (setq i 0)
	            (while (< i len)
	              (setq e (ssname ss i))
                      (delkzsj e app)
                      (setq pt (cdr (assoc 10 (entget e))))
                      (if (setq data (HY_QQ10xx e "ZRBG" 1040)) 
                          (HY_KZSJXZ e nil 10 (list (car pt) (cadr pt) data))
                      ) 
                      (HY_KZSJXZ e (strcat app "-" (itoa subBH)) 1040 1.0 1070 1)
                      (HY_KZSJXZ e (strcat app "-" (itoa subBH)) 1040 1.0 1070 1)
                      (setq New_Pt_SS (ssadd e New_Pt_SS))
                      (setq i (1+ i))
	            )
	           );;;progn
	          )
	      	  
	      	  (if eBJ  
	      	  　　(progn
	      	  　　   (HY_KZSJXZ e (strcat app "-" (itoa subBH)) 1000  "@");;;写新子边界上的扩展数据
	      	         (setq eHand (cdr (assoc 5 (entget ent))))
	      	      )
	      	  )
	      	  (DL_MakeLayer "TF-SUB-BH")
	      	  (setq e1 (ins_SubBh subBH_ins bh subBH nil));;;主区域中插入的子编号标志，没有写扩展数据
	      	  
	      	  (if (and e1 eOldBj) (command ".-group" "" "*" "" e1 eOldBj ""));;;将主区域中插入的子编号标志和子区域做成一个组
	      	  (DL_MakeLayer "PP-TF-BH")
	      	  (setq e2 (ins_SubBh (list (+ (car subBH_ins) xx) (+ yy (cadr subBH_ins))) bh subBH T));;新区域中插入的子编号
	      	  (if e2 
	      	    (progn
	      	      (HY_KZSJXZ e2 (strcat app "-" (itoa subBH)) 1000  "@");;;写新区域编号的扩展数据
	      	      (HY_KZSJXZ e2 "WGBH" 1000 (HY_lst2str (list pmin pmax)) 1005 ehand 1010 (list (car p0) (cadr p0) 0.0) 1040 wgbl 1070 bh)
	      	    )
	      	  )
	      	  ;;;
	      	  
	
	      	  ;;;进行网格处理
	      	  (#ppls "@t_tfwg")
	      	  (if New_Pt_SS
	      	   (progn
	      	  　(BG_dim New_Pt_SS);;;标高标注
	      	    (wgcl_1 New_Pt_SS wgbl (strcat app "-" (itoa subBH)));;;网格处理
	      	    (setq yh_number 1);;;优化次数
	            (DL_MakeLayer "PP-TF-0L");;;土方零线层
	      	    (p_tfjs (strcat app "-" (itoa subBH)) "SJBG");;;土方计算
	      	    (if (= tftj:mode "V");;统计方式
	      	        (setq ff "R"
	      	              ptmp (polar pmax 0.0 wgbl)
	      	        )
	      	        (setq ff "D"
	      	              ptmp (polar pmin (* pi 1.5) wgbl)
                        )
	      	    )
	      	    
	      	    (setq data (tfjs_tjb ff p0 wgbl pmin pmax ptmp (strcat app "-" (itoa subBH))));;;计算土方量
		    (if data (setq p0 (nth 0 data) tf_data (nth 1 data) bp_data (nth 2 data))) 
		    
		    (if (or tf_data bp_data)
		          (draw_tjb  ff p0 wgbl tf_data bp_data)
		          (prompt "\n可用Undo/Back命令取消上次操作.")
		    ) 
	      	   )
	      	  )
      	          (re_osmode)
	      	)
	      )
           )
        )
     )
  )
);;;while
  (command ".ltscale" ltscaleOLD)
  (re_osmode)
)

        

;;ff:统计模式
;;p000 网格原点
;;wgbl 网格大小
;;pmin 网格区域的最小坐标
;;pmax 网格区域的最大坐标
;;pt   用户点取的表头插入点
;;app  该统计区域的应用程序名
;;功能:统计某区域的填挖方(包括边坡).
;;返回值:(表头的真正插入基点 边界内的填挖方表 边坡的填挖方表)
(defun tfjs_tjb(ff p000 wgbl pmin pmax  pt app  /  ft  ang1 ang2 p01 p02 p10 p11 p12 p15 p16 
                                             ss vt vw tf wf e eb ii tf_data bp_data lay laypt laybj
               )
      (setq	lay   "PP-TF-TFBZ"
	        laypt "PP-TF-PT"
	        laybj "PP-TF-BJ"
      )
      (if (or (= ff "U") (= ff "D"))
         (progn
             (if (<= (car p000) (car pmin))
		(progn;
		  (while (< (car p000) (car pmin))
		    (setq p000 (polar p000 0 wgbl))
		  )
		  (setq p000 (polar p000 pi wgbl))
		)
		(progn
		  (while (> (car p000) (car pmin))
		    (setq p000 (polar p000 pi wgbl))
		  )
		)
	      )
	      (setq p000 (list (car p000) (cadr pt)))
	  )
	  (progn
	      (if (>= (cadr p000) (cadr pmax))
		(progn;
		  (while (> (cadr p000) (cadr pmax))
		    (setq p000 (polar p000 (* 1.5 pi) wgbl))
		  )
		  (setq p000 (polar p000 (* 0.5 pi) wgbl))
		)
		(progn
		  (while (< (cadr p000) (cadr pmax))
		    (setq p000 (polar p000 (* 0.5 pi) wgbl))
		  )
		)
	      )
	      (setq p000 (list (car pt) (cadr p000)))
         )
      )
         	       



     (cond 
     ((= ff "U")
       (progn
       	 (setq ang1 (* 0.5 pi))
       	 (setq ang2 0.0)
       )
      )
      ((= ff "D")
       (progn
       	 (setq ang1 (* 1.5 pi))
       	 (setq ang2 0.0)
       )
      )
      ((= ff "L")
       (progn
       	 (setq ang1 pi)
       	 (setq ang2 (* 1.5 pi))
       )
      )
      ((= ff "R")
       (progn
       	(setq ang1 0)
       	(setq ang2 (* 1.5 pi))
      )
     ) 
    );;;;cond
     




      (setq p01 p000
            p06	(polar p01 ang1 wgbl)
      )

      (setq ft t)
      (while ft
	(setq p10 (polar p01 ang2 wgbl)
	      p11 (polar p06 ang2 wgbl)
	)
	;;按行(列)统计
	(setq p12 (polar p10 (+ pi ang2) (* 0.5 wgbl))
	      p15 (polar p12 (+ pi ang2) (* 0.25 wgbl))
	      p16 (polar p12 ang2  (* 0.25 wgbl))
	)

	
	(cond 
	  ((= ff "U")
	    (setq  p16 (list (car p16) (- (cadr pmin) wgbl) 0.0))
	  )
	  ((= ff "D")
	    (setq  p16 (list (car p16) (+ (cadr pmax) wgbl) 0.0))
	  )
	  ((= ff "R")
	   (setq p16 (list  (-  (car pmin) wgbl) (cadr p16) 0.0))
	  )
	  ((= ff "L")
	   (setq p16 (list  (+ (car pmax) wgbl) (cadr p16) 0.0))
	  )
	)
	(setq ss (ssget	"c"
			p15
			p16
			(list (cons 0 "INSERT")
			      (cons 2 "JSCKD")
			      (cons 8 laypt)
			      (list -3 (list app))
			      (list -3 '("TF"))
			      (list -3 '("WF"))
			)
		 )
	)

	(if ss
	  (progn
	    (setq ii 0)
	    (setq wf 0.0
		  tf 0.0
	    )
	    (repeat (sslength ss)
	      (setq e  (ssname ss ii)
		    eb (entget e)
		    vt (HY_QQ10xx e "TF" 1040)
		    vw (HY_QQ10xx e "WF" 1040)
	      )

	      (setq tf (+ tf vt))
	      (setq wf (+ wf vw))
	      (setq ii (1+ ii))
	    )
	    (setq tf_data (cons (list tf wf) tf_data))
	  )
	  (princ)
	)

			;------------------------------------------------------------
        (if (or (= ff "U") (= ff "D"))
            (progn
            	(if (< (car p10) (car pmax))
		  (progn;----- 没到头 ------------------------
		    (setq p01 p10
			  p06 p11
		    )
		  )
	          (setq ft nil);-----   到头 ------------------------
		)
             )
             (progn
             	(if (>(cadr p10) (cadr pmin))
		  (progn;----- 没到头 ------------------------
		    (setq p01 p10
			  p06 p11
		    )
		  )
	          (setq ft nil);-----   到头 ------------------------
		)
	      )
         )
      )
      (setq tf_data (reverse tf_data))
     					;------- BP TF -----------------------------------------------      

      (setq ss (ssget "c"
		      pmin
		      pmax
		      (list '(0 . "LINE,ARC")
			    (cons 8 laybj)
			    '(-3 ("WF"))
			    '(-3 ("TF"))
		      )
	       )
      )
      (if ss
	(progn
	  (setq	ii 0
		wf 0.0
		tf 0.0
	  )
	  (repeat (sslength ss)
	    	(setq e  (ssname ss ii)
		          bpbh (HY_QQ10xx e "BH" 1000)
	    	)
	        (if (= bpbh app)
				(setq wf (+ wf (HY_QQ10xx e "WF" 1040))
					  tf (+ tf (HY_QQ10xx e "TF" 1040))
				)
		    )
			(setq  ii (1+ ii))
	    )
	  (setq bp_data (list tf wf))
	)
    )
    (list p000 tf_data bp_data)
)


(defun draw_tjb(mode p0 wgbl tf_data bp_data / layer ang1 ang2 len1 len2  tf  wf ttff wwff ww p01 p02 p03 p04 p05 p06 
                                               p07 p08  p10 p11  p12  p13  p14  p15  p16  p18 
                                               p19 p20 p21 p22 txth prec
               )
;;ang1:土方统计表从插入基点向宽度方向的角度
;;ang2:土方统计表从插入基点向长度方向的角度
;;len1:统计表每格的宽度
;;len2:统计表每格的长度
  (setq layer "PP-TF-TFBZ")
  (DL_MakeLayer layer)
  (cond 
     ((= mode "U")
       (progn
       	 (setq ang1 (* 0.5 pi))
       	 (setq ang2 0.0)
         (setq len1 (* 0.5  wgbl)
               len2 wgbl
         )      	
       )
      )
      ((= mode "D")
       (progn
       	 (setq ang1 (* 1.5 pi))
       	 (setq ang2 0.0)
       	 (setq len1 (* 0.5  wgbl)
               len2 wgbl
         ) 
         
       )
      )
      ((= mode "L")
       (progn
       	 (setq ang1 pi)
       	 (setq ang2 (* 1.5 pi))
       	 (setq len1 wgbl
               len2 wgbl
         ) 
         	
       )
      )
      ((= mode "R")
       (progn
       	(setq ang1 0)
       	(setq ang2 (* 1.5 pi))
       	(setq len1 wgbl
              len2 wgbl
        ) 
         
      )
     ) 
  );;;;cond
  
  (setq ttff 0.0
        wwff 0.0
  )
  
  (setq txth (/ (Dl_GetTextHeight) (DL_GetDrawingFactor)))	;*** text high
  (setq prec (DL_GetDimPrec))
  (setq p01      p0
        p06	(polar p01 ang1 (* 2.0  len1))
        p02	(polar p01 (+ ang2 pi) len2)
        p04	(polar p02 ang1 len1)
        p05	(polar p04 ang1 len1)
  )
  (command "line" p02 p05 "")
  (command "line" p01 p06 "")

  
  (foreach data tf_data 
     (progn
        (setq tf (nth 0 data)
              wf (nth 1 data)
        )

        (setq p10 (polar p01 ang2 len2)
	      p11 (polar p06 ang2 len2)
	      p12 (polar p10 (+ ang2 pi) (* 0.5 len2))
	      p13 (polar p12 ang1 (* 0.5 len1))
	      p14 (polar p13 ang1 len1)
	)
	(command "text" "j" "mc" p13 txth 0.0 (rtos tf 2 prec))
	(command "text" "j" "mc" p14 txth 0.0 (rtos wf 2 prec))
        (setq ttff (+ ttff tf)
              wwff (+ wwff wf)
        )
        (command "line" p10 p11 "")
        (setq p01 p10
	      p06 p11
	)
      )
  )
  
  (setq p20 (polar p10 ang2 len2)
	p21 (polar p11 ang2 len2)
        p22 (polar p20 ang1 len1)
  )
  (command "line" p10 p11 "")
  (command "line" p20 p21 "")
  (command "line" p02 p20 "")
  (command "line" p05 p21 "")
  (command "line" p04 p22 "")

	    
  (setq  p03  (polar p02 ang2 (* 0.5 len2))
	 p03  (polar p03 ang1 (* 0.5 len1))
	 p07  (polar p03 ang1 len1)
	 p08  (getmid p10 p20)
	 p18  (polar p08 ang1 (* 0.5 len1))
	 p19  (polar p18 ang1 len1)
  )


	(command "text" "j" "mc" p03 txth 0.0 "填方(+)m^3")
	(command "text" "j" "mc" p07 txth 0.0 "挖方(-)m^3")
  
  (if (/= mode "D")
      (setq p08 (polar p08 ang1 (* 2.0 len1)))
  )
  
  (cond 
     ((= mode "L")
      (command "text" "j" "mr" p08 txth 0.0 "合计m^3")
     )
     ((= mode "R")
      (command "text" "j" "ml" p08 txth 0.0 "合计m^3")
     )
     (t
      (command "text" "j" "bc" p08 txth 0.0 "合计m^3")
     )
  )
  
  (command "text" "j" "mc" p18 txth 0.0 (rtos ttff 2 prec))
  (command "text" "j" "mc" p19 txth 0.0 (rtos wwff 2 prec))
      
      
      
  (if bp_data 
    (progn     ;;;写边坡数据
    	  (setq tf (nth 0 bp_data)
    	        wf (nth 1 bp_data)
    	  )
          (setq	p08 (polar p08 ang2 len2)
		p18 (polar p18 ang2 len2)
		p19 (polar p19 ang2 len2)
	  )
	  (cond 
	     ((= mode "L")
	      (command "text" "j" "mr" p08 txth 0.0 "边坡m^3")
	     )
	     ((= mode "R")
	      (command "text" "j" "ml" p08 txth 0.0 "边坡m^3")
	     )
	     (t
	      (command "text" "j" "bc" p08 txth 0.0 "边坡m^3")
	     )
	  )

	  (command "text" "j" "mc" p18 txth 0.0 (rtos tf 2 prec))
	  (command "text" "j" "mc" p19 txth 0.0 (rtos wf 2 prec))
	  (setq	p08 (polar p08 ang2 len2)
		p18 (polar p18 ang2 len2)
		p19 (polar p19 ang2 len2)
	  )
	  (cond 
	     ((= mode "L")
	      (command "text" "j" "mr" p08 txth 0.0 "总计m^3")
	     )
	     ((= mode "R")
	      (command "text" "j" "ml" p08 txth 0.0 "总计m^3")
	     )
	     (t
	      (command "text" "j" "bc" p08 txth 0.0 "总计m^3")
	     )
	  )
	  (command "text" "j" "mc" p18 txth 0.0 (rtos (+ ttff tf) 2 prec))
	  (command "text" "j" "mc" p19 txth 0.0 (rtos (+ wwff wf) 2 prec))

	  (repeat 2
	    (command ".line" p20 (setq p20 (polar p20 ang2 len2)) "")
	    (command ".line" p21 (setq p21 (polar p21 ang2 len2)) "")
	    (command ".line" p22 (setq p22 (polar p22 ang2 len2)) "")
	    (command ".line" p20 p21 "")
	  )
      )
   )
)


;;------------------------------
;; insert  SUB BH
;; 局部统计时在统计区域的中心点或统计放置位置的中心点插入子区域编号
;; pt :编号插入点
;; bh :主区域编号
;; subBH: 子区域编号
;; flag :是否写扩展数据（flag 为nil时不写扩展数据）．
;;------------------------------
(defun ins_SubBh (pt bh subBH flag / laybh sca rr hh eb e_ckd)
  (setq	laybh "PP-TF-BH"
	sca   (DL_GetDrawingFactor)
	rr    (/ 10.0 sca)
	hh    (* 0.5 rr)
  )
  (HY_mktop laybh pt)
  (HY_EntMakeCircle laybh pt rr)
  (HY_EntMakeText laybh (strcat (itoa bh) "-" (itoa subBH)) pt hh 0.0)
  (setq eb (entmake '((0 . "ENDBLK"))))
  (mkins laybh eb pt nil)
  (setq e_ckd (entlast))
  (if flag
      (progn
        (HY_KZSJXZ e_ckd "WGBH" 1070 bh)
        (HY_KZSJXZ e_ckd "SUB" 1070 subBH)
      )
  )
  e_ckd
)
;;------------------------------

(defun get_sub_bh (bh / app ss len  i  e subBH retList)
  (setq app (strcat "A" (itoa bh) "-*"))
  (setq	ss (ssget  "X" (list	(cons 0 "INSERT")
			(cons 8 "PP-TF-BH")
			(list -3 (list app))
			(list -3 '("SUB"))
		       )
            )
  )

  (if ss 
    (progn	
    	(setq len (sslength ss))
	(setq i 0)
	(while (< i len)
	  (setq e (ssname ss i))
          (setq subBH (HY_QQ10xx e "SUB" 1070))
          (setq retList (cons subBH retList))
          (setq i (1+ i))
	)
    )
  )
  retlist
)