;;;------------------------------------------
;;; 1998.01.12 thu
;;; 土方计算
;;; from ZRBG/SJBG ==> 土方量
;;; yhflag ----- 优化控制方式
;;; yh_number -- 初步优化/控制调整
;;;------------------------------------------
(defun t_tfyh (/ dcl_id what laypt lay0 yhflag app kk yh_number)

  (HY_SV)
  (HY_UndoM)
  (setq	laypt "PP-TF-PT"
	lay0 "PP-TF-0L"
	yhflag 0
	yh_number 0
  )
  (DL_MakeLayer lay0)
  (DL_ArxLoad "Earthwork")

  (if (not (setq bhlist (qwgbhb)))
    (progn
      (beep)
      (prompt "\n还没有划分土方网格, 退出.")
      (exit)
    )
  )
  (if (= tfyh~xh nil)
    (setq tfyh~xh "0")
  )
  (if (= tfyh~bh nil)
    (setq tfyh~bh (nth (atoi tfyh~xh) bhlist))
  )

  (init_var)				;*** init. global varibale

  (setq dcl_id (szdl_load_dlg "@t_tfyh.dcl"))
  (setq what 4)
  (while (> what 1)
    (if	(not (new_dialog "t_tfyh" dcl_id))
      (exit)
    )
    (set_t0)
    (act_t0)
    (mod_pt f_bg1 1)
    (mod_pt f_bg2 2)
    (mod_pt f_bg3 3)
    (action_tile "xpt1" "(done_dialog 11)") ;*** (done_dialog 11)
    (action_tile "xpt2" "(done_dialog 12)") ;*** (done_dialog 12)
    (action_tile "xpt3" "(done_dialog 13)") ;*** (done_dialog 13)
    (action_tile "xpd" "(done_dialog 14)") ;*** (done_dialog 14)

    (action_tile "yhjs" "(nbrc)")	;***(done_dialog 2)
    (action_tile "accept" "(done_dialog 3)") ;***(done_dialog 3)
    (action_tile "cancel" "(done_dialog 0)")
    (action_tile "sm" "(sm)")

    (setq what (start_dialog))
    (cond
      ((= what 2) (yhjs_))
      ((= what 3)
       (initget "Y N")
       (setq kk
	      (getkword
		"\n该命令将根据优化结果定义本区域内各点的设计标高, 是否确认(Y/N)?<Y>"
	      )
       )
       (if (/= kk "N")
	 (progn
	   (HY_UndoM)
	   (prompt "\n请稍侯...")
	   (modibg1 app)		;*** modify bg.
	   (prompt "\n可用Undo/Back命令取消上次操作.")
	 )
       )
      )
      ((= what 11) (xpt 1))
      ((= what 12) (xpt 2))
      ((= what 13) (xpt 3))
      ((= what 14) (xpd))
    )
  )
  (unload_dialog dcl_id)
  (arxunload "Earthwork")
  (prompt "\n可用Undo/Back命令取消上次操作.")
  (HY_RV)
)
;;------------------------------
;; 初始化global variable
;;------------------------------
(defun init_var	()

  (if (= tfyh~bh nil)
    (setq tfyh~bh "0")
  )
  (if (= tfyh~xh nil)
    (setq tfyh~xh "0")
  )

  (if (= tfyh~sxxs nil)
    (setq tfyh~sxxs 1.0)
  )
  (if (= tfyh~ysxs nil)
    (setq tfyh~ysxs 1.0)
  )
  (if (= tfyh~ywqt nil)
    (setq tfyh~ywqt 0.0)
  )
  (if (= tfyh~qt nil)
    (setq tfyh~qt 0.0)
  )

  (if (= tfyh~ix nil)
    (setq tfyh~ix 0.0)
  )
  (if (= tfyh~iy nil)
    (setq tfyh~iy 0.0)
  )

  (if (= tfyh~bg0 nil)
    (setq tfyh~bg0 0.0)
  )
  (if (= tfyh~bg1 nil)
    (setq tfyh~bg1 0.0)
  )
  (if (= tfyh~bg2 nil)
    (setq tfyh~bg2 0.0)
  )
  (if (= tfyh~bg3 nil)
    (setq tfyh~bg3 0.0)
  )

  (if (= f_ix nil)
    (setq f_ix "0")
  )
  (if (= f_iy nil)
    (setq f_iy "0")
  )
  (if (= f_bg0 nil)
    (setq f_bg0 "0")
  )
  (if (= f_bg1 nil)
    (setq f_bg1 "0")
  )
  (if (= f_bg2 nil)
    (setq f_bg2 "0")
  )
  (if (= f_bg3 nil)
    (setq f_bg3 "0")
  )

  (if (= tfyh~jiao nil)
    (setq tfyh~jiao 0.0)
  )
  (if (= tfyh~pd nil)
    (setq tfyh~pd 0.0)
  )

  (if (= tfyh~vvww nil)
    (setq tfyh~vvww 0.0)
  )
  (if (= tfyh~vvtt nil)
    (setq tfyh~vvtt 0.0)
  )
  (if (= tfyh~phxs nil)
    (setq tfyh~phxs 0.0)
  )
)
;;------------------------------
(defun set_t0 ()

  (start_list "bh")
  (mapcar 'add_list bhlist)
  (end_list)
  (set_tile "bh" tfyh~xh)

  (if (/= yhflag 0)
    (progn
      (mode_tile "tzcs" 0)
      (mode_tile "yhcs" 0)
      (mode_tile "yhjg" 0)
      (mode_tile "accept" 0)
    )
    (progn
      (mode_tile "tzcs" 1)
      (mode_tile "yhcs" 1)
      (mode_tile "yhjg" 1)
      (mode_tile "accept" 1)
    )
  )
  (set_tile "sxxs" (rtos tfyh~sxxs))
  (set_tile "ysxs" (rtos tfyh~ysxs))
  (set_tile "ywqt" (rtos tfyh~ywqt))
  (set_tile "qt" (rtos tfyh~qt))

  (set_tile "ix" (rtos (* 1000 tfyh~ix)))
  (set_tile "iy" (rtos (* 1000 tfyh~iy)))

  (set_tile "f_ix" f_ix)
  (set_tile "f_iy" f_iy)
  (set_tile "f_bg0" f_bg0)
  (set_tile "f_bg1" f_bg1)
  (set_tile "f_bg2" f_bg2)
  (set_tile "f_bg3" f_bg3)
  (if tfyh~bg0
    (set_tile "bg0" (rtos tfyh~bg0))
  )
  (if tfyh~bg1
    (set_tile "bg1" (rtos tfyh~bg1))
  )
  (if tfyh~bg2
    (set_tile "bg2" (rtos tfyh~bg2))
  )
  (if tfyh~bg3
    (set_tile "bg3" (rtos tfyh~bg3))
  )

  (if tfyh~x1
    (set_tile "pt1x" (rtos tfyh~x1))
  )
  (if tfyh~y1
    (set_tile "pt1y" (rtos tfyh~y1))
  )
  (if tfyh~x2
    (set_tile "pt2x" (rtos tfyh~x2))
  )
  (if tfyh~y2
    (set_tile "pt2y" (rtos tfyh~y2))
  )
  (if tfyh~x3
    (set_tile "pt3x" (rtos tfyh~x3))
  )
  (if tfyh~y3
    (set_tile "pt3y" (rtos tfyh~y3))
  )

  (setq tfyh~jiao (atof (angtos (atan tfyh~iy tfyh~ix) 0 2)))
  (setq tfyh~pd (sqrt (+ (* tfyh~ix tfyh~ix) (* tfyh~iy tfyh~iy))))

  (if tfyh~jiao
    (set_tile "jiao" (rtos tfyh~jiao))
  )
  (if tfyh~pd
    (set_tile "pd" (rtos (* 1000 tfyh~pd)))
  )

  (if tfyh~vvww
    (set_tile "wf" (rtos tfyh~vvww))
  )
  (if tfyh~vvtt
    (set_tile "tf" (rtos tfyh~vvtt))
  )

  (if (equal (+ tfyh~vvtt tfyh~vvww) 0.0 1)
    (setq tfyh~phxs 0.0)
    (setq tfyh~phxs
	   (abs
	     (/	(* 100
		   (- (+ tfyh~vvtt tfyh~qt) (+ tfyh~vvww tfyh~ywqt))
		)
		(+ tfyh~vvtt tfyh~vvww tfyh~ywqt tfyh~qt)
	     )
	   )
    )
  )
  (set_tile "phxs" (rtos tfyh~phxs))
  (if (> tfyh~phxs 5.0)
    (set_tile "error"
	      "点取[优化计算]进行反复计算, 可使结果更加逼近最佳值."
    )
    (errnil)
  )
)
;;------------------------------
(defun act_t0 ()

  (action_tile "bh" "(xbh_)")
  (action_tile
    "sxxs"
    "(setq tfyh~sxxs (atof (get_tile $key)))"
  )
  (action_tile
    "ysxs"
    "(setq tfyh~ysxs (atof (get_tile $key)))"
  )
  (action_tile
    "ywqt"
    "(setq tfyh~ywqt (atof (get_tile $key)))"
  )
  (action_tile "qt" "(setq tfyh~qt   (atof (get_tile $key)))")

  (action_tile "f_ix" "(setq f_ix  (get_tile $key))")
  (action_tile "f_iy" "(setq f_iy  (get_tile $key))")
  (action_tile "f_bg0" "(setq f_bg0 (get_tile $key))")
  (action_tile
    "f_bg1"
    "(progn (setq f_bg1 (get_tile $key))(mod_pt f_bg1 1))"
  )
  (action_tile
    "f_bg2"
    "(progn (setq f_bg2 (get_tile $key))(mod_pt f_bg2 2))"
  )
  (action_tile
    "f_bg3"
    "(progn (setq f_bg3 (get_tile $key))(mod_pt f_bg3 3))"
  )

  (action_tile
    "ix"
    "(setq tfyh~ix  (* 0.001 (atof (get_tile $key))))"
  )
  (action_tile
    "iy"
    "(setq tfyh~iy  (* 0.001 (atof (get_tile $key))))"
  )
  (action_tile "bg0" "(setq tfyh~bg0 (atof (get_tile $key)))")
  (action_tile "bg1" "(setq tfyh~bg1 (atof (get_tile $key)))")
  (action_tile "bg2" "(setq tfyh~bg2 (atof (get_tile $key)))")
  (action_tile "bg3" "(setq tfyh~bg3 (atof (get_tile $key)))")
  (action_tile "jiao" "(mod_xy)")
  (action_tile "pd" "(mod_xy)")

)
;;------------------------------
(defun xbh_ ()
  (setq	tfyh~xh	  (get_tile $key)
	tfyh~bh	  (nth (atoi tfyh~xh) bhlist)
	yhflag	  0
	yh_number 0
	app	  (strcat "A" tfyh~bh)
  )
  (set_t0)
)
;;------------------------------
(defun xpt (ii / pt)

  (initget 1)
  (setq pt (getpoint (strcat "\n控制点" (itoa ii) ":")))
  (cond
    ((= ii 1)
     (setq tfyh~pt1 pt
	   tfyh~x1  (car pt)
	   tfyh~y1  (cadr pt)
     )
    )
    ((= ii 2)
     (setq tfyh~pt2 pt
	   tfyh~x2  (car pt)
	   tfyh~y2  (cadr pt)
     )
    )
    ((= ii 3)
     (setq tfyh~pt3 pt
	   tfyh~x3  (car pt)
	   tfyh~y3  (cadr pt)
     )
    )
  )
)
;;------------------------------
(defun mod_pt (flag ii / ii)

  (setq ii (itoa ii))
  (if (= flag "0")
    (progn
      (mode_tile (strcat "xpt" ii) 1)
      (mode_tile (strcat "pt" ii "x") 1)
      (mode_tile (strcat "pt" ii "y") 1)
      (mode_tile (strcat "bg" ii) 1)
    )
    (progn
      (mode_tile (strcat "xpt" ii) 0)
      (mode_tile (strcat "pt" ii "x") 0)
      (mode_tile (strcat "pt" ii "y") 0)
      (mode_tile (strcat "bg" ii) 0)
    )
  )
)
;;------------------------------
(defun mod_xy (/ ang)

  (setq	tfyh~jiao (atof (get_tile "jiao"))
	ang	  (* (/ tfyh~jiao 180.0) pi)
  )
  (setq tfyh~pd (* 0.001 (atof (get_tile "pd"))))
  (setq	tfyh~ix	(* tfyh~pd (cos ang))
	tfyh~iy	(* tfyh~pd (sin ang))
  )
  (set_tile "ix" (rtos (* 1000 tfyh~ix)))
  (set_tile "iy" (rtos (* 1000 tfyh~iy)))
)
;;------------------------------
(defun xpd (/ pt)

  (initget 1)
  (setq pt (getpoint "\n起点:"))
  (initget 1)
  (setq ang (getangle pt "\n方向:"))
  (initget 1)
  (setq tfyh~pd (getreal "\n坡度(‰):"))
  (setq tfyh~pd (* 0.001 tfyh~pd))
  (setq	tfyh~ix	  (* tfyh~pd (cos ang))
	tfyh~iy	  (* tfyh~pd (sin ang))
	tfyh~jiao (* (/ ang pi) 180.0)
  )
  (setq	f_ix "1"
	f_iy "1"
  )
)
;;------------------------------
(defun nbrc (/ ft)

  (if (/= yhflag 0)
    (progn
      (setq yhflag 99)
      (cond
	((or (< tfyh~sxxs 1.0) (>= tfyh~sxxs 1.5))
	 (beep)
	 (set_tile "error" "松散系数不合适(1.0～1.5).")
	)
	((or (< tfyh~ysxs 0.5) (> tfyh~ysxs 1.0))
	 (beep)
	 (set_tile "error" "压实系数不合适(0.5～1.0).")
	)
	((and (= f_bg1 "1") (= tfyh~pt1 nil))
	 (beep)
	 (set_tile "error" "没有给出控制点1.")
	)
	((and (= f_bg2 "1") (= tfyh~pt2 nil))
	 (beep)
	 (set_tile "error" "没有给出控制点2.")
	)
	((and (= f_bg3 "1") (= tfyh~pt3 nil))
	 (beep)
	 (set_tile "error" "没有给出控制点3.")
	)
					;----- 0. none ------------------------------------
	((= f_ix f_iy f_bg0 f_bg1 f_bg2 f_bg3 "0")
	 (setq yhflag 0)
	)
					;----- 1. bg0  ------------------------------------
	((and (= f_bg0 "1") (= f_ix f_iy f_bg1 f_bg2 f_bg3 "0"))
	 (setq yhflag 1)
	)
					;----- 2. Ix ------------------------------------
	((and (= f_ix "1") (= f_iy f_bg0 f_bg1 f_bg2 f_bg3 "0"))
	 (setq yhflag 2)
	)
					;----- 3. Iy ------------------------------------
	((and (= f_iy "1") (= f_ix f_bg0 f_bg1 f_bg2 f_bg3 "0"))
	 (setq yhflag 3
	       pt00   '(0.0 0.0 0.0)
	       bg00   tfyh~bg0
	 )
	)
					;----- 4. Ix & Iy --------------------------------------------
	((and (= f_ix f_iy "1") (= f_bg0 f_bg1 f_bg2 f_bg3 "0"))
	 (setq yhflag 4)
	)
					;----- 5. Ix & Iy & point ------------------------------------
	((and (= f_ix f_iy f_bg0 "1") (= f_bg1 f_bg2 f_bg3 "0"))
	 (setq yhflag 5
	       pt00   '(0.0 0.0 0.0)
	       bg00   tfyh~bg0
	       pt00   (z_p bg00 pt00)
	 )
	)
	((and (= f_ix f_iy f_bg1 "1") (= f_bg0 f_bg2 f_bg3 "0"))
	 (setq yhflag 5
	       pt00   tfyh~pt1
	       bg00   tfyh~bg1
	       pt00   (z_p bg00 pt00)
	 )
	)
	((and (= f_ix f_iy f_bg2 "1") (= f_bg0 f_bg1 f_bg3 "0"))
	 (setq yhflag 5
	       pt00   tfyh~pt2
	       bg00   tfyh~bg2
	       pt00   (z_p bg00 pt00)
	 )
	)
	((and (= f_ix f_iy f_bg3 "1") (= f_bg0 f_bg2 f_bg1 "0"))
	 (setq yhflag 5
	       pt00   tfyh~pt3
	       bg00   tfyh~bg3
	       pt00   (z_p bg00 pt00)
	 )
	)
					;----- 6. one point ------------------------------------------
	((and (= f_bg1 "1") (= f_ix f_iy f_bg0 f_bg2 f_bg3 "0"))
	 (setq yhflag 6
	       pt00   tfyh~pt1
	       bg00   tfyh~bg1
	       pt00   (z_p bg00 pt00)
	 )
	)
	((and (= f_bg2 "1") (= f_ix f_iy f_bg0 f_bg1 f_bg3 "0"))
	 (setq yhflag 6
	       pt00   tfyh~pt2
	       bg00   tfyh~bg2
	       pt00   (z_p bg00 pt00)
	 )
	)
	((and (= f_bg3 "1") (= f_ix f_iy f_bg0 f_bg1 f_bg2 "0"))
	 (setq yhflag 6
	       pt00   tfyh~pt3
	       bg00   tfyh~bg3
	       pt00   (z_p bg00 pt00)
	 )
	)
					;----- 7. three point ----------------------------------------
	((and (= f_bg1 f_bg2 f_bg3 "1") (= f_ix f_iy f_bg0 "0"))
	 (setq yhflag 7)
	 (setq tfyh~pt1	(z_p tfyh~bg1 tfyh~pt1)
	       tfyh~pt2	(z_p tfyh~bg2 tfyh~pt2)
	       tfyh~pt3	(z_p tfyh~bg3 tfyh~pt3)
	 )
	)
					;----- 99. NULL ----------------------------------------
	(t
	 (beep)
	 (set_tile "error" "没有这种优化方式, 详见右侧[说明]按钮")
	)
      )

      (cond
	((and (= yhflag 5) (or (= pt00 nil) (= bg00 nil)))
	 (beep)
	 (set_tile "error" "没有给出控制点.")
	)
	((and (= yhflag 6) (or (= pt00 nil) (= bg00 nil)))
	 (beep)
	 (set_tile "error" "没有给出控制点.")
	)
	((and (= yhflag 7) (ptpxft tfyh~pt1 tfyh~pt2 tfyh~pt3))
	 (beep)
	 (set_tile "error" "三个控制点不能在一条直线上.")
	)
	((<= yhflag 7)
	 (done_dialog 2)
	)
      )
    )
    (done_dialog 2)			;*** first YH.
  )
)
;;------------------------------
;; 优化计算
;;------------------------------
(defun yhjs_ ()
  ;;;(szload zoombh "@T_tfwg")
  (zoombh (atoi tfyh~bh))
  (setq app (strcat "A" tfyh~bh))
  (p_tfyh)
  (setq yh_number (1+ yh_number))
  (if (= yhflag 0)
    (setq yhflag 99)
  )
)
;;------------------------------
;; zoom w bh
;;此函数从文件 “@T_TFWG.LSP” COPY而来，原因是在优化时，加载了“@T_TFWG.LSP” 文件，
;;继续循环时调用了该文件内的函数，而不是本文件内的函数，导致程序无响应
;;------------------------------
(defun zoombh (bh0 / ss ii e bh ptb p1 p2 ll x y z)

  (setq ss (ssget "x" (list (cons 0 "INSERT") '(-3 ("WGBH")))))
  (setq ii 0)
  (repeat (sslength ss)
    (setq e  (ssname ss ii)
	  bh (HY_QQ10xx e "WGBH" 1070)
	  ii (1+ ii)
    )
    (if	(= bh bh0)
    	(progn
	      (setq ptb	(qxdata e "WGBH"))
		(setq     p1	(car ptb)
		    p2	(cadr ptb)
		)
		(setq x (* 1.0 (car p2))
			y (* 1.0 (cadr p2))
			z 0.0
		)
		(setq p2 (list x y z))

		(setq  ll (* 0.1 (HY_PtPMDist p1 p2)))
		(setq      p1	(polar p1 (angle p2 p1) ll)
		    p2	(polar p2 (angle p1 p2) ll)
	      )
	)
    )
  )
  (zm2pt p1 p2)
)
;;------------------------------
;; 取网格编号LIST
;; return ==>("1" "2" ...)/nil
;;------------------------------
(defun qwgbhb (/ ss ii e bh fhb)

  (setq ss (ssget "x" (list (cons 0 "INSERT") '(-3 ("WGBH")))))
  (if ss
    (progn
      (setq ii 0)
      (repeat (sslength ss)
	(setq e	 (ssname ss ii)
	      bh (HY_QQ10xx e "WGBH" 1070)
	      ii (1+ ii)
	)
	(if (or (null (HY_QQ10xx e "WGBH" 1010)) (null (HY_QQ10xx e "WGBH" 1040)) (member bh fhb)) 
	  (princ)
	  (setq fhb (cons bh fhb))
	)
      )
      (setq fhb (mapcar 'itoa fhb))
    )
  )
  fhb
)
;;------------------------------
;; 3 point in line
;;------------------------------
(defun ptpxft (pt1 pt2 pt3 / angc)
  (setq angc (abs (- (angle pt1 pt2) (angle pt2 pt3))))
  (or (equal angc 0.0 0.1)
      (equal angc pi 0.1)
      (equal angc (* 2.0 pi) 0.1)
  )
)
;;------------------------------
(princ)
