; 由三角网计算土方平衡[mini_tfph].lsp

(or mai_cehui_gcd_blk
   (mai_load_files (mai_panel_search "谜你测绘功能设置文件.lsp"))
)


(defun c:mini_tfph ( / old_cmd get_v_by_high t0 pts high_t high_b ht hh ee vv mm area )

(defun get_v_by_high ( face / p1 p2 p3 h1 h2 h3 b1 b2 b3 s v tt vv sin1 sin3 )
   (mapcar 'set '(p1 p2 p3 h1 h2 h3 b1 b2 b3 s v v2 sin1 sin3) face)
   (cond ((<= ht h1) (list (+ (* s (- h1 ht)) v)))
         ((<= ht h2)
          (setq tt (- ht h1)
                vv (/ (* 0.5 sin1 b1 (/ tt (- h2 h1)) b3 (/ tt (- h3 h1)) tt ) 3.)
          )
          (list (+ (- v (* s tt)) vv) (- vv))
         )
         ((<= ht h3)
          (setq tt (- h3 ht)
                vv (/ (* 0.5 sin3 b2 (/ tt (- h3 h2)) b3 (/ tt (- h3 h1)) tt) 3.)
          )
          (list vv (- (+ (- v2 (* s tt)) vv)))
         )
         ( (list (- v (* s (- ht h1))) ))
   )
)

  (mai_start nil)
  (or mai_tfph (setq mai_tfph 1.2))
  (setq pts (mai_select_first '((0 . "3dface"))
                                    "选择需要计算土方平衡的triangle三角网3dface实体:<回车退出>"
                                    "没有找到任何3dface."
            )
  )
  (if (setq t0 (getdist (strcat "\n输入土方挖填系数:<" (rtos mai_tfph 2 3) ">")))
      (setq mai_tfph t0)
  )
  (princ "\n数据处理中......")
  (setq pts (mapcar 
              '(lambda ( x /  p1 p2 p3 h1 h2 h3 s v h b1 b2 b3 v2  sin1 sin3 )
                  (setq x (entget x)
                        x (mai_remove_same (list (mai_dxf 10 x)(mai_dxf 11 x)(mai_dxf 12 x)(mai_dxf 13 x)))
                        x (vl-sort x '(lambda(m n)(<= (caddr m)(caddr n))))
                  )
                  (mapcar 'set '(p1 p2 p3) x)
                  (setq h1 (caddr p1)
                        h2 (caddr p2)
                        h3 (caddr p3)
                        p1 (mai_3p_2p p1)
                        p2 (mai_3p_2p p2)
                        p3 (mai_3p_2p p3)
                        h (mai_dist_to_line p3 p1 p2)
                        b1 (distance p1 p2)
                        b2 (distance p3 p2)
                        b3 (distance p3 p1)
                        s (* h 0.5 b1)
                        v2 (* s (- h3 h1))
                        v (/ (+ v2 (* 0.5 b1 (- h2 h1) h)) 3.)
                        v2 (- v2 v)
                        sin1  (/ s 0.5 b1 b3)
                        sin3  (/ s 0.5 b2 b3)
                  )
                  (list p1 p2 p3 h1 h2 h3 b1 b2 b3 s v v2  sin1 sin3)
               )
               (mai_ssget_2_list pts)
           )
        high_t (apply 'max (mapcar '(lambda(x)(nth 5 x)) pts))
        high_b (apply 'min (mapcar 'cadddr pts))
        area (apply '+ (mapcar '(lambda(x)(nth 9 x)) pts))
        hh (list high_b high_t)
        ee 100
  )
  (while (and (>= (abs ee) 0.1) (> (abs (apply '- hh)) 0.0001))
     ; (princ (strcat "\n" (rtos ee 2 2)))
     (setq ht (* 0.5 (apply '+ hh))
           vv (apply 'append (mapcar 'get_v_by_high pts))
           vv (mai_list_group_if vv '(lambda(x)(>= x 0)))
           vv (list (apply '+ (car vv)) (apply '+ (cadr vv)))
           ee (+ (* mai_tfph (car vv)) (cadr vv))
           hh (if (> ee 0) (list ht (cadr hh)) (list (car hh) ht))
           mm (cond ((not mm) (list ee vv ht))
                    ((>= (abs ee) (abs (car mm))) mm)
                    ((list ee vv ht))
              )
     )
     ; (princ (strcat "\n下限高【" (rtos (car hh) 2 4) "米】,上限【" (rtos (cadr hh)  2 4) "米】。"))
     ; (getpoint)
  )
  (princ (strcat "\n最大高程 = " (rtos high_b 2 3) " ,最小高程 = " (rtos high_t 2 3) " ,土方平衡高程 = " (rtos (caddr mm) 2 3)))
  (princ (strcat "\n土方平衡时挖方 = " (rtos (caadr mm) 2 3) "立方米 ,填方 = " (rtos (- (cadadr mm)) 2 3) "立方米 ,挖填系数 = " (rtos mai_tfph 2 2)))
  (setq ht (getdist (strcat "\n输入需要计算土方的场地高程【" (rtos high_b 2 3) "~" (rtos high_t 2 3) "】:<退出>")))
  (or ht (exit))
  (setq vv (apply 'append (mapcar 'get_v_by_high pts))
        vv (mai_list_group_if vv '(lambda(x)(>= x 0)))
        vv (list (apply '+ (car vv)) (apply '+ (cadr vv)))
        ee ;(+ (* mai_tfph (car vv)) (cadr vv))
          (list (strcat "平场面积 = " (rtos area 2 3) " 平方米")
                (strcat "最小高程 = " (rtos high_b 2 3) " 米")
                (strcat "最大高程 = " (rtos high_t 2 3) " 米")
                (strcat "平场标高 = " (rtos ht 2 3) " 米")
                (strcat "挖方量 = " (rtos (car vv) 2 2) " 立方米")
                (strcat "填方量 = " (rtos (- (cadr vv)) 2 2) " 立方米")
          )
  )
  (mapcar '(lambda(x)(princ (strcat "\n" x))) ee)
  ; (alert (apply 'strcat ee))
  (setq vv (mai_dos_tempfile "txt"))
  (mai_write_file vv ee)
  (mai_dos_execute (strcat "\"" (mai_panel_search "notepad2.exe") "\" \"" vv "\"") nil)
  (mai_end)
)
