;;;任蔚青修改,增加了一个删格捕捉变量的操作2003-12-31 10:42---
(defun pub_save_var ()
  (setq	w_old_cmdecho  (getvar "cmdecho")
	w_old_blipmode (getvar "blipmode")
	w_old_snapmode (getvar "snapmode")
  )
  (setvar "cmdecho" 0)
  (setvar "blipmode" 0)
)

(defun pub_re_var ()
  (if (or (= w_old_cmdecho 0) (= w_old_cmdecho 1))
    (setvar "cmdecho" w_old_cmdecho)
  )
  (if (or (= w_old_blipmode 0) (= w_old_blipmode 1))
    (setvar "blipmode" w_old_blipmode)
  )
  (setq	w_old_cmdecho  nil
	w_old_blipmode nil
  )
)
;;;6/2/99
(defun $xsort_lst (xc_b / w_fstv w_fhb w_addb w_cmpv w_ffb w_bbb w_next)
  (if (= (type xc_b) 'LIST)
    (progn
      (setq w_do t)
      (foreach w_item xc_b
        (if (= (type w_item) 'LIST)
          (if (or (= (type (car w_item)) 'REAL)
                  (= (type (car w_item)) 'INT)
              )
            (princ)
            (progn
              (setq w_do nil)
              (princ "\n 子表的第一项不是数值!")
            )
          )
          (progn
            (setq w_do nil)
            (princ "\n 表项不是子表!")
          )
        )
      )
      (if w_do
        (progn
          (setq w_fstv (car xc_b)
                xc_b   (cdr xc_b)
                w_fhb  (list w_fstv)
          )
          (while (= (car (setq w_next (car xc_b))) (car w_fstv))
            (setq xc_b  (cdr xc_b)
                  w_fhb (append w_fhb (list w_next))
            )
          )
          (while (setq w_next (car xc_b))
            (setq w_addb (list w_next)
                  w_cmpv (car w_next)
                  xc_b   (cdr xc_b)
            )
            (while (= (car (setq w_next (car xc_b))) w_cmpv)
              (setq xc_b   (cdr xc_b)
                    w_addb (append w_addb (list w_next))
              )
            )
            (cond
              ((>= w_cmpv (car (last w_fhb)))
               (setq w_fhb (append w_fhb w_addb))
              )
              ((<= w_cmpv (caar w_fhb))
               (setq w_fhb (append w_addb w_fhb))
              )
              (t
               (setq w_ffb '()
                     w_bbb w_fhb
               )
               (while (> w_cmpv (car (setq w_next (car w_bbb))))
                 (setq w_ffb (cons w_next w_ffb)
                       w_bbb (cdr w_bbb)
                 )
               )
               (setq w_fhb (append (reverse w_ffb) w_addb w_bbb))
              )
            )
          )
        )
      )
    )
    (princ "\n 所给参数不是表!")
  )
  w_fhb
)

(defun pub_strltrim (s)
  (cond
    ((eq s "") s)
    ((and (/= (ascii s) 32) (/= (ascii s) 9)) s)
    (t (pub_strltrim (substr s 2)))
  )
)
(defun pub_strrtrim (s)
  (cond
    ((eq s "") s)
    ((and (/= (ascii (substr s (strlen s) 1)) 32)
	  (/= (ascii (substr s (strlen s) 1)) 9)
     )
     s
    )
    (t (pub_strrtrim (substr s 1 (1- (strlen s)))))
  )
)

(defun pub_arrow_wmk (insp   ang    /	   d	  dd	 p1	p2
		      p3     p4	    p5	   p6	  pe	 bname	tb_bname
		      blockend
		     )
  (setq	d  (/ (getvar "viewsize") 7.0)
	dd (/ d 10.0)
  )
  (setq	p1 (polar insp (+ ang (* 0.5 pi)) dd)
	p2 (polar insp (- ang (* 0.5 pi)) dd)
	p3 (polar p1 ang (* 0.8 d))
	p4 (polar p2 ang (* 0.8 d))
	p5 (polar p3 (+ ang (* 0.5 pi)) dd)
	p6 (polar p4 (- ang (* 0.5 pi)) dd)
	pe (polar insp ang d)
  )
  (entmake (list '(0 . "block")
		 '(2 . "*U")
		 '(62 . 6)
		 '(70 . 1)
		 (cons 10 insp)
	   )
  )
  (entmake
    (list '(0 . "LINE") '(62 . 6) (cons 10 p1) (cons 11 p3))
  )
  (entmake
    (list '(0 . "LINE") '(62 . 6) (cons 10 p2) (cons 11 p4))
  )
  (entmake
    (list '(0 . "LINE") '(62 . 6) (cons 10 p1) (cons 11 p2))
  )
  (entmake
    (list '(0 . "LINE") '(62 . 6) (cons 10 p3) (cons 11 p5))
  )
  (entmake
    (list '(0 . "LINE") '(62 . 6) (cons 10 p4) (cons 11 p6))
  )
  (entmake
    (list '(0 . "LINE") '(62 . 6) (cons 10 p5) (cons 11 pe))
  )
  (entmake
    (list '(0 . "LINE") '(62 . 6) (cons 10 p6) (cons 11 pe))
  )
  (setq bname (entmake '((0 . "endblk"))))
  (setq tb_bname (cons 2 bname))
  (setq blockend (list '(0 . "INSERT") tb_bname (cons 10 insp)))
  (entmake blockend)
)
(defun pub_lr_pt (xc_p xc_p1 xc_p2 / w_prjp w_ang w_ang1 w_lr)
  (if (null $qtyd1)
    (#ppls "pppp")
  )
  (setq	xc_p  (p# xc_p)
	xc_p1 (p# xc_p1)
	xc_p2 (p# xc_p2)
  )
  (setq	w_prjp ($qtyd1 xc_p xc_p1 xc_p2)
	w_ang  (angle xc_p1 xc_p2)
	w_ang1 (angle w_prjp xc_p)
  )
  (if (eq_ang (+ w_ang (* 0.5 pi)) w_ang1)
    (setq w_lr "L")
    (setq w_lr "R")
  )
)

(defun pub_3d_pmfc (xc_p1   xc_p2   xc_p3   /	    w_abcd  w_bb2
		    w_bb3   w_ff1   w_ff2   w_ff3   w_bb1   w_aa
		    w_bb    w_cc    w_dd
		   )
  (if (or (equal (pmdist xc_p1 xc_p2) 0.001)
	  (equal (pmdist xc_p1 xc_p3) 0.001)
	  (equal (pmdist xc_p3 xc_p2) 0.001)
      )
    (setq w_abcd nil)
    (progn
      (setq w_bb2  (mapcar '- xc_p2 xc_p1)
	    w_bb3  (mapcar '- xc_p3 xc_p1)
	    w_ff1  (car w_bb2)
	    w_ff2  (cadr w_bb2)
	    w_ff3  (caddr w_bb2)
	    w_bb1  (car w_bb3)
	    w_bb2  (cadr w_bb3)
	    w_bb3  (caddr w_bb3)
	    w_aa   (- (* w_ff2 w_bb3) (* w_bb2 w_ff3))
	    w_bb   (- (* w_ff3 w_bb1) (* w_ff1 w_bb3))
	    w_cc   (- (* w_ff1 w_bb2) (* w_bb1 w_ff2))
	    w_dd   (+ (* w_aa (car xc_p1))
		      (* w_bb (cadr xc_p1))
		      (* w_cc (caddr xc_p1))
		   )
	    w_abcd (list w_aa w_bb w_cc w_dd)
      )
    )
  )
  w_abcd
)
(defun pub_pmfc_bg (xc_pt xc_abcd / w_aa w_bb w_cc w_dd w_zz)
  (setq	w_aa (car xc_abcd)
	w_bb (cadr xc_abcd)
	w_cc (caddr xc_abcd)
	w_dd (cadddr xc_abcd)
  )
  (if (equal w_cc 0.0 0.001)
    (setq w_zz nil)
    (setq w_zz (- w_dd (* w_aa (car xc_pt)) (* w_bb (cadr xc_pt)))
	  w_zz (/ w_zz w_cc)
    )
  )
  w_zz
)
;;;求三角形的重心
(defun pub_tria_cenp (xc_ptb   /	w_p1	 w_p2	  w_p3
		      w_ang1   w_ang2	w_ang3	 w_cenp	  w_jpb
		      w_maxj   w_vp	w_bp1	 w_bp2	  w_mp1
		      w_mp2
		     )
  (if (null $jiajiao)
    (#ppls "pppp")
  )
  (setq	w_p1   (car xc_ptb)
	w_p2   (cadr xc_ptb)
	w_p3   (caddr xc_ptb)
	w_ang1 ($jiajiao w_p1 w_p2 w_p3)
	w_ang2 ($jiajiao w_p2 w_p1 w_p3)
	w_ang3 ($jiajiao w_p3 w_p2 w_p1)
  )
  (if (or (equal (rtod w_ang1) 0.0 0.01)
	  (equal (rtod w_ang2) 0.0 0.01)
	  (equal (rtod w_ang3) 0.0 0.01)
      )
    (setq w_cenp (midpt w_p1 w_p2))
    (setq w_jpb	 (list (list w_ang1 w_p1 w_p2 w_p3)
		       (list w_ang2 w_p2 w_p1 w_p3)
		       (list w_ang3 w_p3 w_p1 w_p2)
		 )
	  w_jpb	 (ptbxpx w_jpb)
	  w_maxj (last w_jpb)
	  w_vp	 (nth 1 w_maxj)
	  w_bp1	 (nth 2 w_maxj)
	  w_bp2	 (nth 3 w_maxj)
	  w_mp1	 (midpt w_vp w_bp1)
	  w_mp2	 (midpt w_vp w_bp2)
	  w_cenp (inters w_bp1 w_mp2 w_bp2 w_mp1)
    )
  )
  w_cenp
)
;;;按指定的精度删除点表中的一点
(defun pub_ptb_del (xc_pt xc_ptb xc_prec / w_pt w_fhb)
  (setq w_fhb '())
  (foreach w_pt	xc_ptb
    (if	(> (pmdist w_pt xc_pt) xc_prec)
      (setq w_fhb (cons w_pt w_fhb))
    )
  )
  w_fhb
)
;;;求距某点的最近点
(defun pub_nearest_p (xc_basp xc_pb / w_p0 w_fhb0 w_d0 w_fhb w_ii w_blen
		      w_pt w_d)
  (setq	w_p0   (car xc_pb)
	w_fhb0 (cdr xc_pb)
	w_d0   (pmdist w_p0 xc_basp)
	w_fhb  w_p0
	w_ii   0
	w_blen (length w_fhb0)
  )
  (while (< w_ii w_blen)
    (setq w_pt (nth w_ii w_fhb0)
	  w_d  (pmdist w_pt xc_vp)
    )
    (if	(< w_d w_d0)
      (setq w_d0  w_d
	    w_fhb w_pt
      )
    )
    (setq w_ii (1+ w_ii))
  )
  w_fhb
)
;;;求凸区域点表中某顶点的最近相邻点
;;;xc_vp--某顶点; xc_vpb--去掉某顶点的点表
;;;三维点按 XOY 平面处理
(defun pub_opb_near2pt (xc_vp	 xc_vpb	  /	   w_ilen   w_fhb
			w_ii	 w_ang0	  w_iipb   w_iipt   w_jjpb
			w_jlen	 w_jj	  w_jjpt   w_jang   w_fhb0
		       )
  (if (null $jiajiao)
    (#ppls "pppp")
  )
  (setq w_ilen (length xc_vpb))
  (cond
    ((= w_ilen 0) (setq w_fhb nil))
    ((= w_ilen 1) (setq w_fhb (car xc_vpb)))
    ((= w_ilen 2) (setq w_fhb (pub_nearest_p xc_vp xc_vpb)))
    (t
     (setq w_ii	  0
	   w_ang0 0.0
	   w_iipb xc_vpb
     )
     (while (< w_ii w_ilen)
       (setq w_iipt (nth w_ii w_iipb)
	     w_jjpb (pub_ptb_del w_iipt w_iipb 0.001)
	     w_jlen (length w_jjpb)
	     w_jj   0
       )
       (while (< w_jj w_jlen)
	 (setq w_jjpt (nth w_jj w_jjpb)
	       w_jang ($jiajiao (p# xc_vp) (p# w_iipt) (p# w_jjpt))
	 )
	 (if (or (= w_jang 0.0) (= w_jang pi))
	   (setq w_fhb0	(cons w_iipt w_fhb0)
		 w_fhb0	(cons w_jjpt w_fhb0)
	   )
	   (if (> w_jang w_ang0)
	     (setq w_ang0 w_jang
		   w_fhb  w_jjpt
	     )
	   )
	 )
	 (setq w_jj (1+ w_jj))
       )
       (setq w_ii (1+ w_ii))
     )
    )
  )
  (if w_fhb0
    (setq w_fhb (pub_nearest_p xc_vp w_fhb0))
    w_fhb
  )
)
;;;凸区域点表排序
;;;三维点按 XOY 平面处理
(defun pub_opb_sort (xc_vpb   /	       w_fhb	w_hdpt	 w_vpb
		     w_nrp    w_ilen   w_ang0	w_thpb	 w_eqpb
		     w_ii     w_pt     w_jang	w_thep	 w_eqp
		    )
  (if (null $jiajiao)
    (#ppls "pppp")
  )
  (if (< (length xc_vpb) 4)
    (setq w_fhb xc_vpb)
    (progn
      (setq w_hdpt (car xc_vpb)
	    w_fhb  (list w_hdpt)
	    w_vpb  (cdr xc_vpb)
	    w_nrp  (pub_opb_near2pt w_hdpt w_vpb)
	    w_fhb  (cons w_nrp w_fhb)
	    w_vpb  (pub_ptb_del w_nrp w_vpb 0.001)
      )
;;;begin outside while
      (while (> (length w_vpb) 1)
	(setq w_ilen (length w_vpb)
	      w_ang0 0.0
	      w_thpb nil
	      w_eqpb nil
	      w_ii   0
	)
;;;begin inside while
	(while (< w_ii w_ilen)
	  (setq w_pt (nth w_ii w_vpb))
	  (if (pub_2pt_extpt w_hdpt w_nrp w_pt 0.00001)
	    (setq w_thpb (cons w_pt w_thpb))
	  )
	  (if (null w_thpb)
	    (setq w_jang ($jiajiao (p# w_nrp) (p# w_hdpt) (p# w_pt))
		  w_eqpb (cons (list w_jang w_pt) w_eqpb)
	    )
	  )
	  (setq w_ii (1+ w_ii))
	)
;;;end inside while
	(if w_thpb
	  (progn
	    (setq w_thpb (mapcar 'cadr (pub_ptb_dpx w_nrp w_thpb)))
	    (foreach w_pt w_thpb
	      (setq w_fhb (cons w_pt w_fhb)
		    w_vpb (pub_ptb_del w_pt w_vpb 0.001)
	      )
	    )
	    (setq w_thpb (cons w_nrp w_thpb)
		  w_hdpt (nth (- (length w_thpb) 2) w_thpb)
		  w_nrp	 (last w_thpb)
	    )
	  )
	  (progn
	    (setq w_eqpb (ptbxpx w_eqpb)
		  w_eqpb (reverse w_eqpb)
		  w_thep (list (car w_eqpb))
		  w_eqpb (cdr w_eqpb)
	    )
	    (while (equal (car (setq w_eqp (car w_eqpb)))
			  (caar w_thep)
			  0.001
		   )
	      (setq w_thep (cons w_eqp w_thep)
		    w_eqpb (cdr w_eqpb)
	      )
	    )
	    (setq w_thep (ptbxpx w_thep)
		  w_thep (mapcar 'cadr w_thep)
	    )
	    (foreach w_pt w_thep
	      (setq w_fhb (cons w_pt w_fhb)
		    w_vpb (pub_ptb_del w_pt w_vpb 0.001)
	      )
	    )
	    (setq w_thep (cons w_nrp w_thep)
		  w_hdpt (nth (- (length w_thep) 2) w_thep)
		  w_nrp	 (last w_thep)
	    )
	  )
	)
      )
;;;end outside while
      (if w_fhb
	(if w_vpb
	  (setq w_fhb (cons (car w_vpb) w_fhb))
	)
      )
    )
  )
  w_fhb
)
;;;判断xc_xp是否在xc_sp到xc_ep的延长线上
;;;精度参数xc_prec的单位是度
(defun pub_2pt_extpt (xc_sp xc_ep xc_xp xc_prec / w_ang w_d0 w_d)
  (setq w_ang (abs (- (angle xc_sp xc_ep) (angle xc_sp xc_xp))))
  (if (> w_ang pi)
    (setq w_ang (- (* 2.0 pi) w_ang))
  )
  (if (< (rtod w_ang) xc_prec)
    (progn
      (setq w_d0 (pmdist xc_sp xc_ep)
	    w_d	 (pmdist xc_sp xc_xp)
      )
      (if (> w_d w_d0)
	"EX"
	nil
      )
    )
    nil
  )
)
;;;点表相对于某点按距离排序
(defun pub_ptb_dpx (xc_basp xc_pb / w_blen w_fhb w_preb w_pt w_d)
  (setq w_blen (length xc_pb))
  (if (< w_blen 1)
    (setq w_fhb xc_pb)
    (progn
      (setq w_preb '())
      (foreach w_pt xc_pb
	(setq w_d    (pmdist w_pt xc_basp)
	      w_preb (cons (list w_d w_pt) w_preb)
	)
      )
      (setq w_fhb (ptbxpx w_preb))
    )
  )
  w_fhb
)
;;;按精度过滤点表
(defun pub_ptb_filter (xc_ptb	xc_prec	 /	  w_ptb	   w_fhb
		       w_pt	w_blen	 w_ii	  w_ok	   w_inpt
		       w_pmd
		      )
  (setq	w_ptb xc_ptb
	w_fhb '()
  )
  (while (> (length w_ptb) 1)
    (setq w_pt	 (car w_ptb)
	  w_ptb	 (cdr w_ptb)
	  w_blen (length w_ptb)
	  w_ii	 0
	  w_ok	 1
    )
    (while (< w_ii w_blen)
      (setq w_inpt (nth w_ii w_ptb)
	    w_ii   (1+ w_ii)
	    w_pmd  (pmdist w_pt w_inpt)
      )
      (if (< w_pmd xc_prec)
	(setq w_ii w_blen
	      w_ok 0
	)
      )
    )
    (if	(= w_ok 1)
      (setq w_fhb (cons w_pt w_fhb))
    )
  )
  (cons (car w_ptb) w_fhb)
)
;;;求一个凸区域的内点
(defun pub_ptb_inp (xc_ptb   /	      w_blen   w_inp	w_p1
		    w_p2     w_ptb    w_ang0   w_pt	w_jang
		    w_thep
		   )
  (if (null $jiajiao)
    (#ppls "pppp")
  )
  (setq w_blen (length xc_ptb))
  (cond
    ((< w_blen 3) (setq w_inp nil))
    ((= w_blen 3) (setq w_inp (pub_tria_cenp xc_ptb)))
    ((> w_blen 3)
     (setq w_p1	  (car xc_ptb)
	   w_p2	  (cadr xc_ptb)
	   w_ptb  (cddr xc_ptb)
	   w_ang0 0.0
     )
     (while (> (length w_ptb) 0)
       (setq w_pt   (car w_ptb)
	     w_ptb  (cdr w_ptb)
	     w_jang ($jiajiao w_pt w_p1 w_p2)
       )
       (if (and (> w_jang w_ang0) (< (rtod w_jang) 165.0))
	 (setq w_thep w_pt
	       w_ang0 w_jang
	 )
       )
     )
     (setq w_inp (pub_tria_cenp (list w_p1 w_p2 w_thep)))
    )
  )
  w_inp
)

(defun zoomex(/ p1 p2)
 (setq p1 (getvar "extmax") p2 (getvar "extmin")
    p1 (polar p1 (* pi 0.25) (* (pmdist p1 p2) 0.05))
    p2 (polar p2 (* pi 1.25) (* (pmdist p1 p2) 0.05))
 )
 (if (< (- (car p2) (car p1)) 1.0e8)
 (command "'zoom" "w" p1 p2)
 )
 (princ)
)
