;;;------------------------------
;;; 1998.02.24 tue
;;; 边坡计算
;;; 2002.10.26 modi by macro
;;; 修正了挖填方计算中的数据计算错误
;;;------------------------------
(defun t_bpjs (/ dcl_id what laypt laybj laybp laywg wf tf fdxs)

  (HY_SV)
  (HY_UndoM)
  (setq	laypt "PP-TF-PT"
	laybj "PP-TF-BJ"
	laybp "PP-TF-BP"
	laywg "PP-TF-WG"
	fdxs  1.0			;*** 放大系数 ***
  )
  (setvar "filletrad" 0.0)
  (DL_MakeLayer laybp)
;;  (if (> (getvar "pdsize") 0.1)
;;    (progn
;;      (setvar "pdsize" 0.0001)
;;      (command ".regen")
;;    )
;;  )

  (if (= bpjs~wfpd nil)
    (setq bpjs~wfpd 1.0)
  )
  (if (= bpjs~tfpd nil)
    (setq bpjs~tfpd 1.0)
  )
  (setq	wf 0.0
	tf 0.0
  )

  (setq dcl_id (szdl_load_dlg "@t_bpjs.dcl"))
  (setq what 4)
  (while (> what 1)
    (if	(not (new_dialog "t_bpjs" dcl_id))
      (exit)
    )

    (set_tile "wfpd" (rtos bpjs~wfpd))
    (set_tile "tfpd" (rtos bpjs~tfpd))
    (set_tile "wf" (rtos wf))
    (set_tile "tf" (rtos tf))

    (action_tile "wfpd" "(setq bpjs~wfpd (atof $value))")
    (action_tile "tfpd" "(setq bpjs~tfpd (atof $value))")

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

    (setq what (start_dialog))
    (if	(= what 3)
      (bpjs_)
    )
  )
  (unload_dialog dcl_id)
  (if (> fdxs 1.0)
    (prompt (strcat "\n(测试版, 放大系数" (itoa (fix fdxs)) ")")
    )
  )
  (prompt "\n可用Undo/Back命令取消上次操作.")
  (HY_RV)
)
;;-------------------------------
(defun nbrc ()
  (cond
    ((or (< bpjs~wfpd 0.001) (> bpjs~wfpd 1000000.0))
     (beep)
     (set_tile "error" "挖方边坡不合适(0.001～1000000.0).")
    )
    ((or (< bpjs~tfpd 0.001) (> bpjs~tfpd 1000000.0))
     (beep)
     (set_tile "error" "填方边坡不合适(0.001～1000000.0).")
    )
    (t (done_dialog 3))
  )
)
;;-------------------------------
;;-------------------------------
(defun bpjs_ (/ ss ii e fhb)

  (setq	wf 0.0
	tf 0.0
  )
  (prompt "\n选择土方网格边界线:")
  (setq ss (ssget (list '(0 . "LINE,ARC") (cons 8 laybj) '(-3 ("BH")))))
  (if ss
    (progn
      (setq ii 0)
      (repeat (sslength ss)
	(setq e (ssname ss ii))
	(if (= (cdr (assoc 0 (entget e))) "LINE")
	  (setq fhb (bpjs_L e))		;*** line
	  (setq fhb (bpjs_A e))		;*** arc
	)
	(setq wf (+ wf (nth 0 fhb))
	      tf (+ tf (nth 1 fhb))
	)
	(setq ii (1+ ii))
      )
    )
    (prompt "\n没选.")
  )
)
;;-------------------------------
;; LINE
;;-------------------------------
(defun bpjs_L (e     /	   eb	 p01   p02   angfx ept	 bh    sca
	       sspt  ii	   pt	 dd    pteb  ll	   nn	 wf1   tf1
	       angdx p03   p04	 p05   p06   e1	   e1b	 p11   bgzr1
	       bgsj1 gc1   dd1	 e2    e2b   p12   bgzr2 bgsj2 gc2
	       dd2
	      )

  (setq	eb  (entget e)
	p01 (cdr (assoc 10 eb))
	p02 (cdr (assoc 11 eb))
	bh  (HY_QQ10xx e "BH" 1000)
  )
  (zm2pt p01 p02)
  (setq
    sca	  (car (qqwgin bh))		;*** WGBL
    angfx (car (get_fx e))		;*** out FX
    angdx (+ angfx pi)			;*** short line's ang
  )
  (setq	p01 (z_p 0.0 p01)
	p02 (z_p 0.0 p02)
	wf1 0.0
	tf1 0.0
  )

  (setq	sspt (ssget "f"
		    (list p01 p02)
		    (list '(0 . "POINT")
			  (cons 8 laypt)
			  (list -3 (list bh))
			  '(-3 ("SJBG"))
			  '(-3 ("ZRBG"))
		    )
	     )
  )
  (if (= sspt nil)
    (progn
      (beep)
      (prompt "\n该边线上各点尚未确定自然标高和设计标高.")
    )
    (progn
      (setq sspt (ss_cut sspt bh))
      (setq ii 0)
      (repeat (sslength sspt)
	(setq ept  (ssname sspt ii)
	      eb   (entget ept)
	      pt   (cdr (assoc 10 eb))
	      dd   (HY_PtPMDist p01 pt)
	      pteb (cons (list dd ept) pteb)
	      ii   (1+ ii)
	)
      )

      (setq pteb (HY_SortPtE pteb)
	    pteb (mapcar 'cadr pteb)
      )
      (setq ii 0)
      (repeat (- (length pteb) 1)
	(setq e1    (nth ii pteb)
	      e2    (nth (1+ ii) pteb)
	      e1b   (entget e1)
	      e2b   (entget e2)
	      p11   (cdr (assoc 10 e1b))
	      p12   (cdr (assoc 10 e2b))
	      bgzr1 (caddr p11)
	      bgsj1 (HY_QQ10xx e1 "SJBG" 1040)
	      bgzr2 (caddr p12)
	      bgsj2 (HY_QQ10xx e2 "SJBG" 1040)
	      gc1   (* fdxs (- bgzr1 bgsj1))
	      gc2   (* fdxs (- bgzr2 bgsj2))
	      p11   (z_p 0.0 p11)
	      p12   (z_p 0.0 p12)
	      ll    (distance p11 p12)
	      nn    (fix (/ ll 5.0))
	)
	(if (> gc1 0)
	  (setq dd1 (* gc1 bpjs~wfpd))
	  (setq dd1 (* gc1 bpjs~tfpd))
	)
	(if (> gc2 0)
	  (setq dd2 (* gc2 bpjs~wfpd))
	  (setq dd2 (* gc2 bpjs~tfpd))
	)
	(if (< (* gc1 gc2) 0)
	  (progn		;;一个需要挖方一个需要填方

	    (setq p03 (polar p11 angfx dd1)
		  p04 (polar p12 angfx dd2)
		  p05 (HY_LinePMInt p01 p02 p03 p04 nil)
		  p03 (polar p11 angfx (abs dd1))
		  p04 (polar p12 angfx (abs dd2))
	    )
	    (command ".line" p11 p03 p05 p04 p12 "")

	    (if	(> gc1 0)
	      (progn
		(setq wf1 (+ wf1 (* 0.25 (distance p11 p05) (abs dd1) (abs gc1)))
		      tf1 (+ tf1 (* 0.25 (distance p12 p05) (abs dd2) (abs gc2)))
		)
	      )
	      (progn
		(setq tf1 (+ tf1 (* 0.25 (distance p11 p05) (abs dd1) (abs gc1)))
		      wf1 (+ wf1 (* 0.25 (distance p12 p05) (abs dd2) (abs gc2)))
		)
	      )
	    )
	  )
	  (progn		;;两个都需要挖方或需要填方
	    (setq p03 (polar p11 angfx (abs dd1))
		  p04 (polar p12 angfx (abs dd2))
	    )
	    (command ".line" p11 p03 p04 p12 "")

	    (if	(or (> gc1 0) (> gc2 0))
	      (progn		;;两个都需要挖方

		(setq
		  wf1 (+ wf1
			 (* 0.25 ll (+ (* gc1 dd1) (* gc2 dd2)))
		      )
		)
		(cond
		  ((<= nn 2)
		   (setq p05 (getmid p03 p04)
			 dd  (* 0.25 (+ dd1 dd2))
		   )
		   (command ".line" p05 (polar p05 angdx dd) "")

		  )
		  (t
		   (setq p05 (getmid p03 p04)
			 dd  (* 0.5 (+ dd1 dd2))
		   )
		   (command ".line" p05 (polar p05 angdx dd) "")

		   (setq p06 (getmid p03 p05)
			 dd1 (* 0.25 (+ dd dd1))
		   )
		   (command ".line" p06 (polar p06 angdx dd1) "")

		   (setq p06 (getmid p04 p05)
			 dd1 (* 0.25 (+ dd dd2))
		   )
		   (command ".line" p06 (polar p06 angdx dd1) "")

		  )
		)
	      )
	      (progn		;;两个都需要填方	

		(setq
		  tf1 (+ tf1
			 (* 0.25 ll (+ (* (abs gc1) (abs dd1)) (* (abs gc2) (abs dd2))))
		      )
		)
		(cond
		  ((<= nn 2)
		   (setq p05 (getmid p11 p12)
			 dd  (* 0.25 (+ dd1 dd2))
		   )
		   (command ".line" p05 (polar p05 angdx dd) "")

		  )
		  (t
		   (setq p05 (getmid p11 p12)
			 dd  (* 0.5 (+ dd1 dd2))
		   )
		   (command ".line" p05 (polar p05 angdx dd) "")

		   (setq p06 (getmid p11 p05)
			 dd1 (* 0.25 (+ dd dd1))
		   )
		   (command ".line" p06 (polar p06 angdx dd1) "")

		   (setq p06 (getmid p12 p05)
			 dd1 (* 0.25 (+ dd dd2))
		   )
		   (command ".line" p06 (polar p06 angdx dd1) "")

		  )
		)
	      )
	    )
	  )
	)
	(setq ii (1+ ii))
      )
      (HY_KZSJXZ e "WF" 1040 wf1 1041 angfx)
      (HY_KZSJXZ e "TF" 1040 tf1)
      (dj_pt e p01)
      (dj_pt e p02)
    )
  )
  (list wf1 tf1)
)
;;-------------------------------
;; ARC
;;-------------------------------
(defun bpjs_a (e      /	     eb	    p00	   rr	  an1	 an2	p01
	       p02    ptb    pteb   sspt   ii	  wf1	 tf1	flag
	       angfx1 angfx2 angdx1 angdx2 ept	  bh
	      )

;;  (if (< (abs (getvar "pdsize")) 1.0)
;;    (progn
;;      (setvar "pdsize" 1.0)
;;      (setvar "pdmode" 35)
;;      (command "regen")
;;    )
;;  )
  (setq	eb   (entget e)
	p00  (cdr (assoc 10 eb))
	p00  (z_p 0.0 p00)
	rr   (cdr (assoc 40 eb))
	an1  (cdr (assoc 50 eb))
	an2  (cdr (assoc 51 eb))
	p01  (polar p00 an1 rr)
	p02  (polar p00 an2 rr)
	ptb  (gethp p00 p01 p02 32)
	ptb  (cons p01 ptb)
	ptb  (append ptb (list p02))
	wf1  0.0
	tf1  0.0
	flag (caddr (get_fx e))
	bh   (HY_QQ10xx e "BH" 1000)
  )
  (setq	sspt (ssget "f"
		    ptb
		    (list '(0 . "POINT")
			  (cons 8 laypt)
			  (list -3 (list bh))
			  '(-3 ("SJBG"))
			  '(-3 ("ZRBG"))
		    )
	     )
  )
  (if (= sspt nil)
    (progn
      (beep)
      (prompt "\n该边线上各点尚未确定自然标高和设计标高.")
    )
    (progn
      (setq sspt (ss_cut sspt bh))
      (setq ii 0)
      (repeat (sslength sspt)
	(setq ept  (ssname sspt ii)
	      eb   (entget ept)
	      pt   (cdr (assoc 10 eb))
	      dd   (len_pt pt e)
	      pteb (cons (list dd ept) pteb)
	      ii   (1+ ii)
	)
      )
      (setq pteb (HY_SortPtE pteb)
	    pteb (mapcar 'cadr pteb)
      )
      (setq ii 0)
      (repeat (- (length pteb) 1)
	(setq e1    (nth ii pteb)
	      e2    (nth (1+ ii) pteb)
	      e1b   (entget e1)
	      e2b   (entget e2)
	      p11   (cdr (assoc 10 e1b))
	      p12   (cdr (assoc 10 e2b))
	      bgzr1 (caddr p11)
	      bgsj1 (HY_QQ10xx e1 "SJBG" 1040)
	      bgzr2 (caddr p12)
	      bgsj2 (HY_QQ10xx e2 "SJBG" 1040)
	      gc1   (* fdxs (- bgzr1 bgsj1))
	      gc2   (* fdxs (- bgzr2 bgsj2))
	      p11   (z_p 0.0 p11)
	      p12   (z_p 0.0 p12)
	      ll    (distance p11 p12)
	      nn    (fix (/ ll 5.0))
	)
	(if (= flag 1)
	  (setq	angfx1 (angle p00 p11)
		angdx1 (angle p11 p00)
		angfx2 (angle p00 p12)
		angdx2 (angle p12 p00)
	  )
	  (setq	angfx1 (angle p11 p00)
		angdx1 (angle p00 p11)
		angfx2 (angle p12 p00)
		angdx2 (angle p00 p12)
	  )
	)
	(if (> gc1 0)
	  (setq dd1 (* gc1 bpjs~wfpd))
	  (setq dd1 (* gc1 bpjs~tfpd))
	)
	(if (> gc2 0)
	  (setq dd2 (* gc2 bpjs~wfpd))
	  (setq dd2 (* gc2 bpjs~tfpd))
	)
	(if (< (* gc1 gc2) 0)
	  (progn
	    (setq p03 (polar p11 angfx1 dd1)
		  p04 (polar p12 angfx2 dd2)
		  p05 (HY_LinePMInt p11 p12 p03 p04 nil)
		  p03 (polar p11 angfx1 (abs dd1))
		  p04 (polar p12 angfx2 (abs dd2))
	    )
	    (command ".line" p11 p03 p05 p04 p12 "")
	    (if	(> gc1 0)
	      (progn
		(setq wf1 (+ wf1 (* 0.25 (distance p11 p05) (abs dd1) (abs gc1)))
		      tf1 (+ tf1 (* 0.25 (distance p12 p05) (abs dd2) (abs gc2)))
		)
	      )
	      (progn
		(setq tf1 (+ tf1 (* 0.25 (distance p11 p05) (abs dd1) (abs gc1)))
		      wf1 (+ wf1 (* 0.25 (distance p12 p05) (abs dd2) (abs gc2)))
		)
	      )
	    )
	  )
	  (progn
	    (setq p03 (polar p11 angfx1 (abs dd1))
		  p04 (polar p12 angfx2 (abs dd2))
	    )
	    (command ".line" p11 p03 p04 p12 "")
	    (if	(or (> gc1 0) (> gc2 0))
	      (progn
		(setq
		  wf1 (+ wf1
			 (* 0.25 ll (+ (* gc1 dd1) (* gc2 dd2)))
		      )
		)
		(cond
		  ((<= nn 2)
		   (setq p05 (getmid p03 p04)
			 dd  (* 0.25 (+ dd1 dd2))
		   )
		   (command ".line" p05 (polar p05 angdx1 dd) "")
		  )
		  (t
		   (setq p05 (getmid p03 p04)
			 dd  (* 0.5 (+ dd1 dd2))
		   )
		   (command ".line" p05 (polar p05 angdx1 dd) "")
		   (setq p06 (getmid p03 p05)
			 dd1 (* 0.25 (+ dd dd1))
		   )
		   (command ".line" p06 (polar p06 angdx1 dd1) "")
		   (setq p06 (getmid p04 p05)
			 dd1 (* 0.25 (+ dd dd2))
		   )
		   (command ".line" p06 (polar p06 angdx2 dd1) "")
		  )
		)
	      )
	      (progn
		(setq
		  tf1 (+ tf1
			 (* 0.25 ll (+ (* gc1 dd1) (* gc2 dd2)))
		      )
		)
		(cond
		  ((<= nn 2)
		   (setq p05 (getmid p11 p12)
			 dd  (* 0.25 (+ dd1 dd2))
		   )
		   (command ".line" p05 (polar p05 angdx1 dd) "")
		  )
		  (t
		   (setq p05 (getmid p11 p12)
			 dd  (* 0.5 (+ dd1 dd2))
		   )
		   (command ".line" p05 (polar p05 angdx1 dd) "")
		   (setq p06 (getmid p11 p05)
			 dd1 (* 0.25 (+ dd dd1))
		   )
		   (command ".line" p06 (polar p06 angdx1 dd1) "")
		   (setq p06 (getmid p12 p05)
			 dd1 (* 0.25 (+ dd dd2))
		   )
		   (command ".line" p06 (polar p06 angdx2 dd1) "")
		  )
		)
	      )
	    )
	  )
	)
	(setq ii (1+ ii))
      )
      (HY_KZSJXZ e "WF" 1040 wf1 1041 (float flag))
      (HY_KZSJXZ e "TF" 1040 tf1)
      (dj_pt e p01)
      (dj_pt e p02)
    )
  )
  (list wf1 tf1)
)
;;------------------------------
;; 取area info.
;; ==>(bl insert_point origin_point pmin pmax)
;;------------------------------
(defun qqwgin (bh / 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)
	      b	  (HY_QQ10xx e "WGBH" 1040) ;*** scale
	      ptb (qxdata e "WGBH")	;*** pmin/pmax
	      ii  (1+ ii)
	)
	(if (= bh h)
	  (setq
	    fhb	(cons b (cons p0 (cons (HY_QQ10xx e "WGBH" 1010) ptb)))
	  )
	)
      )
    )
  )
  fhb
)
;;-------------------------------
;; get_fx(e)
;; return ==> ang
;;-------------------------------
(defun get_fx (e / eb p01 p02 ang angfx p03 p04 sst rr fhb)

  (setq eb (entget e))
  (if (= (cdr (assoc 0 eb)) "LINE")
    (progn
      (setq p01	  (cdr (assoc 10 eb))
	    p02	  (cdr (assoc 11 eb))
	    ang	  (angle p01 p02)
	    angfx (+ ang (* 0.5 pi))
	    p03	  (polar p01 angfx 1.0)
	    p04	  (polar p02 angfx 1.0)
	    sst	  (ssget "f"
			 (list p03 p04)
			 (list '(0 . "LINE") (cons 8 laywg))
		  )
      )
      (if sst
	(setq angfx (- ang (* 0.5 pi)))
      )
      (setq fhb (list angfx nil nil))
    )
    (progn
      (setq p01	(cdr (assoc 10 eb))
	    rr	(cdr (assoc 40 eb))
	    ang	(cdr (assoc 50 eb))
	    p02	(polar p01 ang rr)
	    sst	(ssget "f"
		       (list p01 p02)
		       (list '(0 . "LINE") (cons 8 laywg))
		)
      )
      (if sst
	(setq fhb (list nil p01 1))	;*** from center to far
	(setq fhb (list nil p01 0))	;*** from far to center
      )
    )
  )
  fhb
)
;;----------------------------------------------
;; 1997.01.17 fri
;; 取ARC之等分点 gethp(pc ps pe nn)
;; pc/ps/pe : center/start/end point
;; nn : number
;; return ==>(p1 p2 ... pnn) from strart to end
;;----------------------------------------------
(defun gethp (p00 ps pe nn / rr angs ange angc angf pt ptb flag jj)

  (setq	rr   (HY_PtPMDist p00 ps)
	angs (angle p00 ps)
	ange (angle p00 pe)
  )
  (if (equal angs (* 2.0 pi) 0.05)
    (setq angs 0.0)
  )
  (if (equal ange (* 2.0 pi) 0.05)
    (setq ange 0.0)
  )
  (setq angc (- ange angs))
  (cond
    ((< angc (- pi))
     (setq flag	"Z"
	   jj	+
	   angc	(+ angc pi pi)
     )
    )
    ((< angc 0.0)
     (setq flag	"F"
	   jj	-
	   angc	(- angc)
     )
    )
    ((< angc pi)
     (setq flag	"Z"
	   jj	+
     )
    )
    ((> angc pi)
     (setq flag	"F"
	   jj	-
	   angc	(- (* 2.0 pi) angc)
     )
    )
    (t
     (prompt "\n计算ARC等分点时出错!")
     (beep)
     (exit)
    )
  )
  (setq angf (/ angc (+ nn 1)))
  (repeat nn
    (setq pt   (polar p00 (jj angs angf) rr)
	  ptb  (cons pt ptb)
	  angs (jj angs angf)
    )
  )
  (reverse ptb)
)
;;--------------------------------------------
;; distance of a point(on arc) to start point
;;--------------------------------------------
(defun len_pt (pt ent / entb r pc ans ane)
  (setq	pt   (z_p 0.0 pt)
	entb (entget ent)
	r    (cdr (assoc 40 entb))
	pc   (cdr (assoc 10 entb))
	ans  (cdr (assoc 50 entb))
	ane  (angle pc pt)
  )
  (if (< (- ane ans) -0.001)
    (setq ane (+ ane (* 2 pi)))
  )
  (* r (- ane ans))
)
;;-------------------------------
(defun ss_cut (ss app / ii sst e quan)
  (setq	ii  0
	sst (ssadd)
  )
  (repeat (sslength ss)
    (setq e    (ssname ss ii)
	  quan (HY_QQ10xx e app 1040)
    )
    (if	(< quan 1.0)
      (setq sst (ssadd e sst))
    )
    (setq ii (1+ ii))
  )
  sst
)
;;-------------------------------
;; fillet
;;-------------------------------
(defun dj_pt (e pt / p01 p02 ss e1 e2 ept)

  (setq	p01 (polar pt 0.78 1.0)
	p02 (polar pt 3.82 1.0)
	ss  (ssget "c"
		   p01
		   p02
		   (list '(0 . "LINE,ARC")
			 (cons 8 laybj)
			 '(-3 ("WF"))
			 '(-3 ("TF"))
		   )
	    )
  )
  (if (and ss (= (sslength ss) 2))
    (progn
      (setq e1	(ssname ss 0)
	    e2	(ssname ss 1)
	    ept	(HY_PtName pt 0.0 0.0 0.1)
	    e1	(get_dje e1 ept pt)
	    e2	(get_dje e2 ept pt)
      )
      (if (and e1 e2)
	(command ".fillet" e1 e2)
      )
    )
  )
)
;;-------------------------------
(defun get_dje (e ept pt / eb p00 bgzr bgsj elev dd angfx	p01 p02	ss flag
		e1 e1b pt fhb)

  (setq	eb   (entget ept)
	p00  (cdr (assoc 10 eb))
	bgzr (caddr p00)
	bgsj (HY_QQ10xx ept "SJBG" 1040)
	elev (abs (* fdxs (- bgzr bgsj)))
  )
  (if (> elev 0)
    (setq dd (/ elev bpjs~wfpd))
    (setq dd (/ elev bpjs~tfpd))
  )

  (setq eb (entget e))
  (if (= (cdr (assoc 0 eb)) "LINE")
    (setq angfx	(HY_QQ10xx e "WF" 1041)
	  p00	(polar pt angfx dd)
    )
    (progn
      (setq p00	 (cdr (assoc 10 eb))
	    flag (fix (HY_QQ10xx e "WF" 1041))
      )
      (if (= flag 1)
	(setq p00 (polar pt (angle p00 pt) dd))
	(setq p00 (polar pt (angle pt p00) dd))
      )
    )
  )

  (setq	p01 (polar p00 0.78 0.5)
	p02 (polar p00 3.82 0.5)
	ss  (ssget "c"
		   p01
		   p02
		   (list '(0 . "LINE")
			 (cons 8 laybp)
			 '(-4 . "<OR")
			 '(-4 . "<AND")
			 '(-4 . "<=,<=,*")
			 (cons 10 p01)
			 '(-4 . ">=,>=,*")
			 (cons 10 p02)
			 '(-4 . "AND>")
			 '(-4 . "<AND")
			 '(-4 . "<=,<=,*")
			 (cons 11 p01)
			 '(-4 . ">=,>=,*")
			 (cons 11 p02)
			 '(-4 . "AND>")
			 '(-4 . "OR>")
		   )
	    )
  )
  (if (and ss (= (sslength ss) 2))
    (progn
      (setq e1	(ssname ss 0)
	    e1b	(entget e1)
	    p01	(cdr (assoc 10 e1b))
	    p02	(cdr (assoc 11 e1b))
      )
      (if (or (equal (HY_PtPMDist p01 pt) 0.0 0.01)
	      (equal (HY_PtPMDist p02 pt) 0.0 0.01)
	  )
	(setq e1  (ssname ss 1)
	      e1b (entget e1)
	      p01 (cdr (assoc 10 e1b))
	      p02 (cdr (assoc 11 e1b))
	)
      )
      (setq pt	(getmid p01 p02)
	    fhb	(list e1 pt)
      )
    )
  )
  fhb
)
;;; 1998.03.04 wed
;;; 区域移动
;;;------------------------------
(defun t_qyyd (/ bh app ss)

  (HY_Set1)
  (initget 6)
  (setq bh (getint "\n输入区域编号<1>:"))
  (if (= bh nil)
    (setq bh 1)
  )
  (setq app (strcat "A" (itoa bh)))

  (if (not (qqwgin bh))
    (progn
      (beep)
      (prompt "\n该编号区域没有定义。")
    )
    (progn
      (setq ss (ssget "x" (list (list -3 (list app)))))
      (if ss
	(progn
	  (command ".move" ss "")
	  (while (/= (getvar "cmdnames") "") (command pause))
	)
      )
    )
  )
  (princ)
)
;;-------------------------------
(princ)
