
(defun #is_line	(ent)
  (if (and (= (type ent) 'ENAME)
           (= (cdr (assoc 0 (entget ent))) "LINE")
      ) 
    t
    nil
  )
)
;;;
;;; Test a point `pt' to see if it is on the line `sp--ep'.
;;;
(defun pt_onl (sp ep pt)
  (setq	sp (p# sp)
				ep (p# ep)
				pt (p# pt)
  )
  (cond
    ((equal sp pt 0.0001) T)
    ((equal ep pt 0.0001) T)
    (t
  (if (inters sp
	      ep
	      pt
	      (polar pt (+ (angle sp ep) (/ pi 2)) 0.01)
	      T
      )
    T
    nil
  )
    ) ;;;end of t
  );;;end of (cond
)
;;;
;;; Test a point `pt' to see if it is on the arc `arc'.
;;;
;;;modi 1998.11.03
;;;arc pt or (list pc r sa ea)
(defun pt_ona (arc pt / cpt sa ea ang r entb)
  (if (listp arc)
    (setq cpt (p# (car arc))
          r   (cadr arc)
          sa  (caddr arc)       ; angle of current ent start point
          ea  (cadddr arc)      ; angle of current ent end point
          pt  (p# pt)
          ang (angle cpt pt)              ; angle to pt.

    )
    (setq entb (entget arc)
          pt (p# pt) 
          cpt (p# (cdr (assoc 10 entb)))
          sa  (cdr (assoc 50 entb))               ; angle of current ent start point
          ea  (cdr (assoc 51 entb))               ; angle of current ent end point
          ang (angle cpt pt)              ; angle to pt.
          r   (cdr (assoc 40 entb))
        
    )
  )
  (cond
    ((equal (polar cpt sa r) pt 0.0001) T)
    ((equal (polar cpt ea r) pt 0.0001) T)
    (t
      (if (> sa ea)
        (if (and (or (and (> ang sa) (< ang (+ ea (* 2 pi))))
	             (and (> ang (- ea (* 2 pi))) (< ang ea))
                 )
                (equal (pmdist cpt pt) r 0.0001)
            )
          T
          nil
        )
        (if (and (> ang sa) (< ang ea)           
                (equal (pmdist cpt pt) r 0.0001)
            )
          T
          nil
        )
      )
    )
  )
)
;;; Intersection point of two arcs or circles
;;; a    = radius of ename 1
;;; b    = distance from curcpt to prvcpt
;;; c    = radius of ename 2
;;; curcpt = center point of first circle or arc 
;;; prvcpt = center point of second circle or arc
;;;
;;; ipt_aa == Intersect_Point: Arc_and_Arc, Circle_and_Circle, Circle_and_Arc 
;;;en1 en2 or (list pc r ans ane etype1) (list pc r ans ane etype2)
;;;modi 1998.11.16
(defun ipt_aa (en1    en2    /	    a	   b	  c	 s	ang
	       alpha  ipt    curcpt prvcpt tpt1	  tpt2	 etype1	etyp2 entb1 entb2
	      )
  (if (= (type en1) 'ENAME)
    (setq entb1 (entget en1)
 	curcpt (p# (cdr (assoc 10 entb1)))
	c      (cdr (assoc 40 entb1))
       etype1 (cdr (assoc 0 entb1))
    )
    (setq curcpt (p# (car en1))
	c      (cadr en1)
       etype1  (if (= (length en1) 4) "ARC" (last en1))
    )
  )
  (if (= (type en2) 'ENAME)
    (setq entb2 (entget en2)
 	prvcpt (p# (cdr (assoc 10 entb2)))
	a      (cdr (assoc 40 entb2))
       etype2 (cdr (assoc 0 entb2))
     )
     (setq prvcpt (p# (car en2))
  	   a      (cadr en2)
          etype2  (if (= (length en2) 4) "ARC" (last en2))
     )
   )

  (setq b    (pmdist curcpt prvcpt)
 	 s      (/ (+ a b c) 2.0)
	 ang   (angle curcpt prvcpt)
  )
  (cond
    ;; circles are tangent
    ;; If (- s a) == 0, this would cause a divide by zero below...
    ((or (= (- s a) 0)
	 (equal b (+ a c) 0.001)
	 (equal b (abs (- a c)) 0.001)
     )
     ;; Circles are tangent.
     (setq ipt nil)
    )
    ;; circles do not intersect
    ((and (or (> b (+ a c))
	      (if (> c a)
		(< (+ a b) c)
		(< (+ c b) a)
	      )
	  )
	  (not (equal (+ a b) c (/ (+ a b c) 1000000)))
     )
     ;; No intersection.
     (setq ipt nil)
    )
    (T
     ;; general law of cosines formula -- (- s a) != 0
     (setq alpha (* 2.0
		    (atan (sqrt	(abs (/	(* (- s b) (- s c))
					(* s (- s a))
				     )
				)
			  )
		    )
		 )
     )

     (setq tpt1	(polar curcpt (+ ang alpha) c)
	   tpt2	(polar curcpt (- ang alpha) c)
     )
     ;; Two intersections. Now...
     (cond
       ((= etype1 etype2 "CIRCLE")
	(setq ipt (list tpt1 tpt2))
       )
       ((= etype1 etype2 "ARC")
	(if (and (pt_ona en1 tpt1) (pt_ona en2 tpt1))
	  (setq ipt (cons tpt1 ipt))
	)
	(if (and (pt_ona en1 tpt2) (pt_ona en2 tpt2))
	  (setq ipt (cons tpt2 ipt))
	)
       )
       ((and (= etype1 "ARC") (= etype2 "CIRCLE"))
	(if (pt_ona en1 tpt1)
	  (setq ipt (cons tpt1 ipt))
	)
	(if (pt_ona en1 tpt2)
	  (setq ipt (cons tpt2 ipt))
	)
       )
       ((and (= etype2 "ARC") (= etype1 "CIRCLE"))
	(if (pt_ona en2 tpt1)
	  (setq ipt (cons tpt1 ipt))
	)
	(if (pt_ona en2 tpt2)
	  (setq ipt (cons tpt2 ipt))
	)
       )
     )
    )
  )
  ipt					; return point
)
					;
					;
;;------------------------------
;; Inters of Line & Arc
;; ipt_la(e_line e_arc)
;; ipt_la(e_arc e_line)
;;------------------------------
(defun ipt_la (e1 e2 / e1b p1 p2)
  (if (#is_line e2)
    (setq e1b e2
	  e2  e1
	  e1  e1b
    )
  )
  (setq	e1b (entget e1)
	p1  (p# (cdr (assoc 10 e1b)))
	p2  (p# (cdr (assoc 11 e1b)))
  )
  (cal_ila p1 p2 e2)
)
;;;
;;; p1 and p2 are two points on a line
;;; arc  == entity name of arc
;;;
;;; cal_ila == Calculate Intersect_Arc_with_Line
;;;modi 1998.11.16
(defun cal_ila (p1 p2 arc / d pi2 rad ang nang temp ipt	cpt theta l ipt1
		ipt2 etype entb)
  (if (= (type arc) 'ENAME)
    (setq entb (entget arc)
   	cpt  (p#(cdr (assoc 10 entb)))
       rad (cdr (assoc 40 entb))
       etype (cdr (assoc 0 entb)) 
	pi2  (/ pi 2)			; 1/2 pi
	ang  (angle p1 p2)
	nang (+ ang pi2)		; Normal to "ang"
	temp (interss p1 p2 cpt (polar cpt nang 1) nil)
	nang (angle cpt temp)
    )
    (setq cpt (car arc) rad (cadr arc)
       etype (if (= (length arc) 4) "ARC" (last arc))
	pi2  (/ pi 2)			; 1/2 pi
	ang  (angle p1 p2)
	nang (+ ang pi2)		; Normal to "ang"
	temp (interss p1 p2 cpt (polar cpt nang 1) nil)
	nang (angle cpt temp)
    ) 
  )
  ;; Get the perpendicular distance from the center of the arc to the line.
  (setq d (pmdist cpt temp))
  (cond
    ((equal rad d 0.01)
     ;; One intersection.
     (setq ipt (list temp))
    )
    ((< rad d)
     ;; No intersection.
    )
    (T
     ;; Two intersections. Now...
     (if (equal d 0.0 0.01)
       (setq theta pi2
	     nang  (+ ang pi2)		; Normal to "ang"
       )
       (setq l	   (sqrt (abs (- (expt rad 2) (expt d 2))))
	     theta (abs (atan (/ l d)))
       )
     )
     ;; Get the two angles to the infinite intersection points of the 
     ;; congruent circle to the arc, and the line, then get the two 
     ;; intersection points.
     (setq ipt1 (polar cpt (- nang theta) rad))
     (setq ipt2 (polar cpt (+ nang theta) rad))
     (if (= etype "CIRCLE")
       ;(setq ipt (list ipt1 ipt2))
       (progn
 	  (if (pt_onl p1 p2 ipt1)
 	   (setq ipt (cons ipt1 ipt))
	  )
	  (if (pt_onl p1 p2 ipt2)
	    (setq ipt (cons ipt2 ipt))
	  )
       )
       (progn
	 (if (and (pt_ona arc ipt1) (pt_onl p1 p2 ipt1))
	   (setq ipt (cons ipt1 ipt))
	 )
	 (if (and (pt_ona arc ipt2) (pt_onl p1 p2 ipt2))
	   (setq ipt (cons ipt2 ipt))
	 )
       )
     )
    )
  )
  ipt
)
;;;
(defun calali (p1 p2 wb	/ pt rr	ang ll p11 p12 p01 jcdb	dl an1 an2 ll2
       enlx)
  (if (= (type wb) 'ENAME)
    (setq wb (entget wb))
  )
  (setq	enlx (cdr (assoc 0 wb))
         ll2  (pmdist p1 p2)
  )
  (setq	pt  (cdr (assoc 10 wb))
	      rr  (cdr (assoc 40 wb))
      	an1 (cdr (assoc 50 wb))
	      an2 (cdr (assoc 51 wb))
  )
  (if (= enlx "ARC")
	  (setq p11 (polar pt an1 rr) p12 (polar pt an2 rr))
	)
  (setq	ang (angle p1 p2)
	      p01 (interss p1 p2 pt (polar pt (+ ang (* pi 0.5)) 1026.0) nil)
	      ll  (pmdist pt p01)
  )
  (cond
    ((equal ll 0.0 0.0001)
     (setq p11 (polar pt ang rr) p12 (polar pt (+ ang pi) rr) )
     (if (and (<= (pmdist p11 p1) (+ (pmdist p1 p2) 0.0001))
	            (<= (pmdist p11 p2) (+ (pmdist p1 p2) 0.0001))
	       )
       (setq jcdb (cons p11 jcdb))
     )
     (if (and (<= (pmdist p12 p1) (+ (pmdist p1 p2) 0.0001))
	            (<= (pmdist p12 p2) (+ (pmdist p1 p2) 0.0001))
	       )
       (setq jcdb (cons p12 jcdb))
     )
    )
    ((equal ll rr 0.0001)
     (if (and (<= (pmdist p01 p1) (+ (pmdist p1 p2) 0.0001))
	            (<= (pmdist p01 p2) (+ (pmdist p1 p2) 0.0001))
	       )
      (progn
	     (if (= enlx "CIRCLE")
	      (setq jcdb (cons p01 jcdb))
	      (if (= enlx "ARC")
	       (progn
	        (cond
					 ((equal (pmdist p01 p11) 0.0 0.00001)
					  (setq jcdb (cons p01 jcdb))
					 )
					 ((equal (pmdist p01 p12) 0.0 0.00001)
					  (setq jcdb (cons p01 jcdb))
					 )
					 ((interss p11 p12 pt p01 "T")
					  (setq ang (angle pt p01))
					  (if (< an2 an1)
					    (setq an2 (+ an2 (* pi 2.0)))
					  )
					  (if (< ang an1)
					    (setq ang (+ ang (* pi 2.0)))
					  )
					  (if (<= ang (+ an2 0.000001))
					    (setq jcdb (cons p01 jcdb))
					  )    ;end of if <= ang
					 )
	        )      ;end of cond 
	       )
	      )        ;end of if enlx "ARC"
	     )         ;end of if enlx "CIRCLE"
      )
     )    ;end of if and
    )
    ((< ll rr)
     (setq dl (sqrt (abs (- (* rr rr) (* ll ll)))))
     (setq p11 (polar p01 ang dl)
	         p12 (polar p01 (+ ang pi) dl)
     )
     (setq ang (angle pt p11))
     (if (= enlx "ARC")
       (progn
				 (if (> an2 an1)
				   (if (and (>= ang an1)
					    (<= ang an2)
					    (<= (pmdist p11 p1) ll2)
					    (<= (pmdist p11 p2) ll2)
				       )
				     (setq jcdb (cons p11 jcdb))
				   )
				   (if (and (not (and (> ang an2) (< ang an1)))
					    (<= (pmdist p11 p1) ll2)
					    (<= (pmdist p11 p2) ll2)
				       )
				     (setq jcdb (cons p11 jcdb))
				   )
				 )
				 (setq ang (angle pt p12))
				 (if (> an2 an1)
				   (if (and (>= ang an1)
					    (<= ang an2)
					    (<= (pmdist p12 p1) ll2)
					    (<= (pmdist p12 p2) ll2)
				       )
				     (setq jcdb (cons p12 jcdb))
				   )
				   (if (and (not (and (> ang an2) (< ang an1)))
					    (<= (pmdist p12 p1) ll2)
					    (<= (pmdist p12 p2) ll2)
				       )
				     (setq jcdb (cons p12 jcdb))
				   )
				 )
       )
       (progn
				 (if (and (<= (pmdist p11 p1) ll2) (<= (pmdist p11 p2) ll2))
				   (setq jcdb (cons p11 jcdb))
				 )
				 (if (and (<= (pmdist p12 p1) ll2) (<= (pmdist p12 p2) ll2))
				   (setq jcdb (cons p12 jcdb))
				 )
       )
     )
    )
  )
  jcdb
)					;end of defun
;;;一条线(line/arc/circle/*polyline/(list p1 p2))与选择集求交点(list (p s))
;;;
(defun ipt_ess (EN1 SS / EN2 P PT LEN N P1 P2 P3 P4 ENTB PTB ISLINE_E1 ISLINE_E2 ISPOINT_E1)
  (IF SS
    (PROGN
      (SETQ LEN	(SSLENGTH SS)
	    N	0
      )
      (REPEAT LEN
	(SETQ EN2 (SSNAME SS N)
	      N	  (1+ N)
              p  (ipt2e en1 en2)
	)
	(FOREACH PT P
	  (SETQ PTB (CONS (list PT en2) PTB))
	)
      )
    )
  )
  PTB
)
;;;
(defun #lstdel (lis v / n tmp flag jd)
  (setq	flag (and v (listp v))
	jd   0.001
  )
  (foreach n lis
    (if	(not (or (and (null flag) (equal n v jd))
		 (and flag (#eq_v n v jd))
	     )
	)
      (setq tmp (cons n tmp))
    )
  )
  (reverse tmp)
)
;;;
(defun #eq_v (m n jd / lis x y)
  (setq lis (mapcar '(lambda (x y) (equal x y jd)) m n))
  (if (member nil lis)
    nil
    T
  )
)
;;;
;;;1998.02.21
(defun #entlen (ent / ptb len etype entb)
  (setq	entb  (entget ent)
	etype (cdr (assoc 0 entb))
  )
  (if (or (= etype "LINE")
          (= etype "ARC")
          (= etype "CIRCLE")
          (wcmatch etype "*POLYLINE")
          (= etype "SPLINE")
       )
       (setq len (HY_QXPMCD ent))
  )

;;  (cond
;;    ((= etype "LINE")
;;     (setq ptb (bg-ypp ent))
;;     (setq len (pmdist (car ptb) (cadr ptb)))
;;    )
;;    ((= etype "ARC")
;;     (setq len (arc_len ent))
;;    )
;;    ((= etype "CIRCLE")
;;     (setq len (* 2 pi (cdr (assoc 40 entb))))
;;    )
;;    ((wcmatch etype "*POLYLINE")
;;     (setq len (pl_len ent))
;;    )
;;  )
  len
)
;;;POLYLINE or LWPOLYLINE'S LENGTH 
(defun pl_len (en / len loop p1 p2 entb v42 r ang l p0 s etype BH n i)
;;;  (setq	entb  (entget en)
;;;	etype (cdr (assoc 0 entb))
;;;        BH (= (cdr (assoc 70 entb)) 1)
;;;  )
;;;  (if (= etype "POLYLINE")
;;;    (progn
;;;      (setq s en ;;;17:18 99-1-23
;;;            s (entnext s)
;;;	    entb (entget s)
;;;	    p1	 (cdr (assoc 10 entb))
;;;	    v42	 (cdr (assoc 42 entb))
;;;	    p0	 p1
;;;      )
;;;      (setq loop t
;;;	    len	0
;;;      )
;;;      (while loop
;;;	(if (= (cdr (assoc 0 entb)) "SEQEND")
;;;	  (setq loop nil)
;;;	  (progn
;;;	    (setq s    (entnext s)
;;;		  entb (entget s)
;;;		  p2   (cdr (assoc 10 entb))
;;;	    )
;;;     (if (and (null p2) BH)
;;;	      (setq p2 p0)
;;;	    )
;;;	    (if	p2
;;;	      (progn
;;;		(if (zerop v42)
;;;		  (setq l (pmdist p1 p2))
;;;		  (setq	ang (* 4.0 (atan (abs v42)))
;;;			r   (/ (pmdist p1 p2) 2.0 (sin (* 0.5 ang)))
;;;			l   (* ang r)
;;;		  )
;;;		)
;;;		(setq v42 (cdr (assoc 42 entb))
;;;		      p1  p2
;;;		      len (+ len l)
;;;		)
;;;	      )
;;;	    )
;;;	  )
;;;	)
;;;      )
;;;    )
;;;    (progn
;;;;;;lwpolyline
;;;	   (setq n   (cdr (assoc 90 entb))
;;;		 i   (##getindex (assoc 10 entb) entb)
;;;		 p1  (cdr (nth i entb))
;;;		 v42 (cdr (nth (+ i 3) entb))
;;;		 i   (+ i 4)
;;;		 p0  p1
;;;		 len 0
;;;	   )
;;;    (if (not BH)
;;;;;;not close
;;;	     (setq n (1- n))
;;;	   )
;;;	   (while (> n 0)
;;;;;;loop n times
;;;      (if (and (= n 1) BH)
;;;	       (setq p2 p0)
;;;;;;close
;;;	       (setq p2 (cdr (nth i entb)))
;;;	     )
;;;	     (if (zerop v42)
;;;	       (setq l (pmdist p1 p2))
;;;	       (setq ang (* 4.0 (atan (abs v42)))
;;;		     r	 (/ (pmdist p1 p2) 2.0 (sin (* 0.5 ang)))
;;;		     l	 (* ang r)
;;;	       )
;;;	     )
;;;	     (setq len (+ len l)
;;;		   p1  p2
;;;		   v42 (cdr (nth (+ i 3) entb))
;;;		   i   (+ i 4)
;;;		   n   (1- n)
;;;	     )
;;;	   )
;;;    )
;;;  )
;;;  len

  (setq etype (cdr (assoc 70 (entget en))))
  (if (or (= etype 0) (= etype 1) (= etype 2) (= etype 4) (= etype 8));;;只处理简单PLINE线，过滤出polyface,polygon等
      (command ".area" "o" en)
  )
  (getvar "perimeter")
)

;;;cc is prompt str and lay is layer name
;;;or 
;;;cc is (list ent pt) and lay is distance to start point pt
(defun #lend_pos (cc lay / ent entb p0 p1 p2 pt	etype ptb r pc len ang
		  dis elast)
  (if (= (type cc) 'STR)
    (setq ent (HY_SelSingleEnt cc "LINE,*POLYLINE,ARC" lay nil nil))
    (setq ent cc dis lay)
  )
  (if (and ent (listp ent))
    (progn
      (setq p0	  (cadr ent)
	    ent	  (car ent)
	    ptb	  (bg-ypp ent)
	    p1	  (last ptb)
	    p2	  (car ptb)
	    entb  (entget ent)
	    etype (cdr (assoc 0 entb))
      )
      (cond
	((= etype "LINE")
	 (setq len (pmdist p1 p2))
	 (setq ang (angle p1 p2))
         (if (= (type cc) 'STR) (progn 
  	   (setvar "snapang" ang)
   	   (setvar "orthomode" 1)
         )) 
	)
	((= etype "ARC")
	 (setq len (arc_len ent)
	       pc  (cdr (assoc 10 entb))
	       r   (cdr (assoc 40 entb))
	 )
	)
	(t
	 (setq len (pl_len ent))
	)
      )
      (if (< (pmdist p1 p0) (pmdist p2 p0))
	(setq pt p1)
	(setq pt p2)
      )
      (if (null dis) (progn
        (d_mark pt)
        (setq dis
	       (getdist
	         pt
	         (strcat "\n输入距近端距离(最大为:" (rtos len 2 2) ")<0>:")
       	       )
        ) 
        (d_mark pt)
      ))
      (if dis
	(progn
	  (setq dis (min dis len))
	  (cond
	    ((= etype "LINE")
	     (if (equal pt p2 0.01)
	       (setq ang (angle p2 p1))
	     )
	     (setq pt (polar pt ang dis))
	    )
	    ((= etype "ARC")
	     (if (> (angle pc p0) (setq ang (angle pc pt)))
	       (setq pt (polar pc (+ ang (/ dis r)) r))
	       (setq pt (polar pc (- ang (/ dis r)) r))
	     )
	    )
	    (T
             ;(if (not (zerop dis)) (progn
             (if (not (equal dis 0.0 0.0001)) (progn
	     (#undo_init)
	     (command ".undo" "group")
	     (setq elast (ent_last))
	     (command ".measure" (list ent pt) dis)
	     (command ".undo" "e")
	     (if (equal pt p1 0.01)
	       (setq ent (entnext elast)
		     pt	 (cdr (assoc 10 (entget ent)))
	       )
	       (setq ent (entlast)
		     pt	 (cdr (assoc 10 (entget ent)))
	       )
	     )
	     (command ".u")
             ))
	    )
	  )
	)
      )
      (span pt)
    )
  )
  pt
)
;;;Add an item to a list behind current pos 
;;; Pass a number , an add item and a list and recieve the list back with 
;;; that item added.
(defun add_item	(pos lis additem / j n tmp)
  (setq	tmp '()
	j   0
  )
  (if (equal '() lis)
    (setq tmp (cons additem tmp))
    (progn
      (foreach n lis
	(if (< pos j)
	  (setq tmp (cons n tmp))
	  (if (= pos j)
	    (setq tmp (cons n tmp)
		  tmp (cons additem tmp)
	    )
	    (setq tmp (cons n tmp))
	  )
	)
	(setq j (1+ j))
      )
      (setq tmp (reverse tmp))
    )
  )
)
;;;modi 10:46 98-11-12
;;;提道路宽度
(defun #rwid (ent / tmp n rxdwid wid en)
  (if (and ent (= (strcase(cdr (assoc 8 (entget ent)))) "ROAD-1")) (progn ;;;19:42 
    (setq en (HY_QQ10xx ent "dwapp" 1000))
    (if en 
      (setq en (handent en))
      (if en
       (if (entget en)
         (setq wid (HY_QQ10xx en "dwapp" 1040))
         (progn
	   (entdel en)
           (setq wid (HY_QQ10xx en "dwapp" 1040))
	   (entdel en)
	 )  
       )
      )
    ))
    (if (and ent (entget ent)) (setq wid (HY_QQ10xx ent "dwapp" 1040)))
  )
  (if (and ent (null wid)) (progn
    (setq en (HY_QQ10xx ent "dwapp" 1000))
    (if en (setq en (handent en)))
    (if en
      (if (entget en)
        (setq wid (HY_QQ10xx en "dwapp" 1040))
        (progn
	  (entdel en)
          (setq wid (HY_QQ10xx en "dwapp" 1040))
	  (entdel en)
	)  
      )
    )
  ))
  wid
)

(defun sa_menu (m_item)
  (setvar "cmdecho" 0)
  (setq pps_cnt_smenuitem m_item)
  (princ)
)
(defun re_menu ()
  (setvar "cmdecho" 0)
  (if pps_cnt_smenuitem
    (menucmd (strcat "s=" pps_cnt_smenuitem))
  )
  (setq pps_cnt_smenuitem nil)
  (setvar "cmdecho" 1)
  (princ)
)
;;----------------------------------------
;; 1998.06.10
;; modi 1998.07.07
;; 取POLYLINE's or LWPOLYLINE VERTEX --- getplvex(e)
;; e --- POLYLINE or LWPOLYLINE
;; fhb ==> (((x y z) bulge) ((x y z) bulge) ...) 
;; (x y z)=ITEM10;bulge=ITEM42
;;----------------------------------------
(defun getplvex	(e / e1 e1b lx pt tq fhb fftt ff70 entb n i etype mat)
  (if (listp e)
    (setq mat (caddr e) e (car e))
  )
  (setq	entb  (entget e)
	etype (cdr (assoc 0 entb))
	ff70  (cdr (assoc 70 entb))
  )
;;;POLYLINE
  (if (= etype "POLYLINE")
    (progn
      (setq fftt t)
      (while fftt
	(setq e1 (entnext e))
	(setq e1b (entget e1))
	(setq lx (cdr (assoc 0 e1b)))
	(if (= lx "VERTEX")
	  (progn
	    (setq pt (cdr (assoc 10 e1b)))
            (if mat (setq pt (pt_m2wcs pt mat)))
	    (setq tq (cdr (assoc 42 e1b)))
	    (setq fhb (append (list (list pt tq)) fhb))
	    (setq e e1)
	  )
	  (setq fftt nil)		;***** lx = "SEQEND"
	)
      )
    )
    (progn
;;; LWPOLYLINE
      (setq n (cdr (assoc 90 entb))
	    ;i (##getindex (assoc 10 entb) entb)
      )
      (repeat n
	(setq pt  (cdr (assoc 10 entb))
	      pt  (list (car pt) (cadr pt) 0.0)
        )
        (if mat (setq pt (pt_m2wcs pt mat)))
	(setq tq  (cdr (assoc 42 entb))
	      fhb (append (list (list pt tq)) fhb)
	      ;i	  (+ i 4)
	      entb (cdr (member (assoc 10 entb) entb))
	)
      )
    )
  )
;;;-------
  (if (= ff70 1)
    (setq fhb (cons (last fhb) fhb))
  )					;*** closed.
  (setq fhb (reverse fhb))
)

;;;get polyline's first subent or lwpolyline's first segment's infomation
(defun pl_1s (ent / entb p1 tq p2 ang r pc etype s1 s2 entb2 pm)
  (setq	entb  (entget ent)
	etype (cdr (assoc 0 entb))
  )
  (if (= etype "POLYLINE")
    (progn
      (setq s1	 (entnext ent)
	    entb (entget s1)
	    p1	 (cdr (assoc 10 entb))
	    tq	 (cdr (assoc 42 entb))
      )
      (if (zerop tq)
	(setq s2    (entnext s1)
	      entb2 (entget s2)
	      p2    (cdr (assoc 10 entb2))
	      ang   (angle p1 p2)
	      pm    (midpt p1 p2)
	)
	(setq entb (p_arc s1)
	      pc   (car entb)
	      r	   (cadr entb)
	      ang  (angle pc p1)
	      ang  (+ ang (/ pi 2))
	      pm   (nth 5 entb)
	)
      )
    )
    (progn
;;; LWPOLYLINE
	   (setq p1 (assoc 10 entb)
		 tq (cdr (assoc 42 entb))
		 entb (cdr (member (assoc 10 entb) entb))
		 p2 (p# (cdr (assoc 10 entb))) ;;;2/25/99add p#
		 p1 (p# (cdr p1));;;2/25/99add p#
	   )
	   (if (zerop tq)
	     (setq ang (angle p1 p2)
		   pm  (midpt p1 p2)
	     )
	     (progn
	       (setq ang (* 4.0 (atan (abs tq)))
		     r	 (/ (pmdist p1 p2) 2.0 (sin (* 0.5 ang)))
	       )
	       (if (> tq 0)
		 (setq pc (polar p1 (+ (angle p1 p2) (* 0.5 (- pi ang))) r)
		       pm (polar pc (- (angle p1 p2) (/ pi 2)) r)
		 )
		 (setq pc (polar p1 (- (angle p1 p2) (* 0.5 (- pi ang))) r)
		       pm (polar pc (- (angle p2 p1) (/ pi 2)) r)
		 )
	       )
	       (setq ang (angle pc p1)
		     ang (+ ang (/ pi 2))
	       )
	     )
	   )
    )
  )
  (list p1 p2 ang tq pc r pm)
)
;;-----------------------------
(defun #lay (flag layb / lay)
  (command "layer")
  (foreach lay layb
    (if (and (/= (strcase flag) "ON") (= (getvar "clayer") (STRCASE lay)))
      (command flag lay "Y")
      (command flag lay)
    ) 
  )
  (command "")
)

(defun $undob(uctr)
  (if (<= (getvar "undomarks") uctr)
    (prompt "\n已全部回退!")
    (HY_UndoB)    
  )
)
(defun span (pt) (pan2v pt))
(defun #mark(pt)
  (pan2v pt)
  (szdl_ins_sysblk "dl-c" pt (dw-PSC 29.5) (dw-PSC 29.5) 0)
  (setq last_markent (entlast))
)
;;;
(defun delkzsj(ent regn / kzsj n)
  (if (null regn) (setq regn "*"))
  (setq kzsj (cdr (assoc -3 (entget ent (list regn)))))
  (if kzsj (progn
    (setq kzsj (mapcar 'car kzsj))
    (foreach n kzsj
      (HY_KZSJXZ ent n)
    )
  ))
)
;;;
(defun ipt2pl(e1 e2 / ipt iptb cs1 cs2 etype1 etype2 plcs1 plcs2 p1 p2 p3 p4)
  (if (null &pl_en_cs) (#ppls"&@pp_Zxp"))
  (setq plcs1 (&pl_en_cs e1)
        plcs2 (&pl_en_cs e2)
  )
  (foreach cs1 plcs1
    (setq etype1 (car cs1))  
    (foreach cs2 plcs2
      (setq etype2 (car cs2)) 
      (cond
        ((and (= etype1 "LINE") (= etype2 "LINE"))
          (setq p1 (cadr cs1)
                p2 (caddr cs1)
                p3 (cadr cs2)
                p4 (caddr cs2)
                ipt (interss p1 p2 p3 p4 t)
          )
          (if ipt (setq iptb (append iptb (list ipt))))   
        )
        ((and (= etype1 "LINE") (= etype2 "ARC"))
          (setq p1 (cadr cs1)
                p2 (caddr cs1)
          )
          (if (> (nth 8 cs2) 0)  ;;;v42
            (setq ipt (cal_ila p1 p2 (list (nth 1 cs2) (nth 7 cs2) (nth 4 cs2) (nth 5 cs2) ))) ;;;(list pc r ans ane)
            (setq ipt (cal_ila p1 p2 (list (nth 1 cs2) (nth 7 cs2) (nth 5 cs2) (nth 4 cs2) )))
          )
          (setq iptb (append iptb ipt))   
        )
        ((and (= etype2 "LINE") (= etype1 "ARC"))
          (setq p1 (cadr cs2)
                p2 (caddr cs2)
          )
          (if (> (nth 8 cs1) 0)  ;;;v42
            (setq ipt (cal_ila p1 p2 (list (nth 1 cs1) (nth 7 cs1) (nth 4 cs1) (nth 5 cs1) )))
            (setq ipt (cal_ila p1 p2 (list (nth 1 cs1) (nth 7 cs1) (nth 5 cs1) (nth 4 cs1) ))) ;;;(list pc r ans ane)
          )
          (setq iptb (append iptb ipt))   
        )
        ((and (= etype2 "ARC") (= etype1 "ARC"))
          (if (> (nth 8 cs1) 0)  ;;;v42
            (if (> (nth 8 cs2) 0)  ;;;v42
              (setq ipt (ipt_aa (list (nth 1 cs1) (nth 7 cs1) (nth 4 cs1) (nth 5 cs1)) 
                                (list (nth 1 cs2) (nth 7 cs2) (nth 4 cs2) (nth 5 cs2))
               )) ;;;(list pc r ans ane)
              (setq ipt (ipt_aa (list (nth 1 cs1) (nth 7 cs1) (nth 4 cs1) (nth 5 cs1)) 
                                (list (nth 1 cs2) (nth 7 cs2) (nth 5 cs2) (nth 4 cs2))
               ))
            )
            (if (> (nth 8 cs2) 0)  ;;;v42
              (setq ipt (ipt_aa (list (nth 1 cs1) (nth 7 cs1) (nth 5 cs1) (nth 4 cs1)) 
                                (list (nth 1 cs2) (nth 7 cs2) (nth 4 cs2) (nth 5 cs2))
               )) ;;;(list pc r ans ane)
              (setq ipt (ipt_aa (list (nth 1 cs1) (nth 7 cs1) (nth 5 cs1) (nth 4 cs1)) 
                                (list (nth 1 cs2) (nth 7 cs2) (nth 5 cs2) (nth 4 cs2))
               )) ;;;(list pc r ans ane)
            )
          )
          (setq iptb (append iptb ipt))   
        )
      ) 
    )
  )
  iptb
)
;;;
;;; ipt_apl == Intersect_Point: Arc_and_*POLYLINE, Circle_and_*POLYLINE
;;; e1:arc or circle
;;; e2:polyline or lwpolyline
(defun ipt_apl(e1 e2 / ipt iptb cs2 etype1 etype2 plcs2 p1 p2)
  (if (null &pl_en_cs) (#ppls"&@pp_zxp"))
  (setq plcs2 (&pl_en_cs e2)
  )
  (if (= (type e1) 'ENAME) 
    (setq etype1 (cdr (assoc 0 (entget e1))))  
    (setq etype1 (if (= (length e1) 4) "ARC" (last e1)))
  )
  (foreach cs2 plcs2
    (setq etype2 (car cs2)) 
    (cond
      ((and (wcmatch etype1 "ARC,CIRCLE")(= etype2 "LINE"))
        (setq p1 (cadr cs2)
              p2 (caddr cs2)
        )
        (setq ipt (cal_ila p1 p2 e1))
        (setq iptb (append iptb ipt))   
      )
      ((and (wcmatch etype1 "ARC,CIRCLE")(= etype2 "ARC"))
        (if (> (nth 8 cs2) 0)  ;;;v42
          (setq ipt (ipt_aa e1 (list (nth 1 cs2) (nth 7 cs2) (nth 4 cs2) (nth 5 cs2)) )) ;;;(list pc r ans ane)
          (setq ipt (ipt_aa e1 (list (nth 1 cs2) (nth 7 cs2) (nth 5 cs2) (nth 4 cs2)) ))
        )
        (setq iptb (append iptb ipt))   
      )
    ) 
  )
  iptb
)
;;;
(defun ipt2e(e1 e2 / entb1 etype1 entb2 etype2 p1 p2 p3 p4 ipt pt ptb ptb1 pt-online)
  (if (listp e1)
    (setq p1 (car e1) p2 (cadr e1))
    (setq entb1 (entget e1)
          etype1 (cdr (assoc 0 entb1))
    )
  )
  (setq entb2  (entget e2)
        etype2 (cdr (assoc 0 entb2))
  )
  (cond
    ((and (listp e1)(= etype2 "LINE"))
      (setq p3 (cdr (assoc 10 entb2))
            p4 (cdr (assoc 11 entb2))
            ipt (interss p1 p2 p3 p4 t)
      )
      (if ipt (setq ipt (list ipt)))   
    ) 
    ((and (listp e1) (wcmatch etype2 "ARC,CIRCLE"))
       (setq ipt (cal_ila p1 p2 e2))
    )
    ((and (listp e1) (wcmatch etype2 "*POLYLINE"))
      (setq ipt (car (HY_LinePLineInt e2 p1 p2)))
    )
    ((and (= etype1 "LINE") (= etype2 "LINE"))
      (setq p1 (cdr (assoc 10 entb1))
            p2 (cdr (assoc 11 entb1))
            p3 (cdr (assoc 10 entb2))
            p4 (cdr (assoc 11 entb2))
            ipt (interss p1 p2 p3 p4 t)
      )
      (if ipt (setq ipt (list ipt)))   
    )
    ((or
       (and (= etype1 "LINE") (wcmatch etype2 "ARC,CIRCLE"))
       (and (wcmatch etype1 "ARC,CIRCLE") (= etype2 "LINE"))
     ) 
      (setq ipt (ipt_la e1 e2))
    )
    ((and (wcmatch etype1 "ARC,CIRCLE") (wcmatch etype2 "ARC,CIRCLE"))
      (setq ipt (ipt_aa e1 e2))
    )
    ((and (= etype1 "LINE") (wcmatch etype2 "*POLYLINE"))
      (setq p1 (cdr (assoc 10 entb1))
            p2 (cdr (assoc 11 entb1))
            ipt (car (HY_LinePLineInt e2 p1 p2))
      )
    )
    ((and (= etype2 "LINE") (wcmatch etype1 "*POLYLINE"))
      (setq p1 (cdr (assoc 10 entb2))
            p2 (cdr (assoc 11 entb2))
            ipt (car (HY_LinePLineInt e1 p1 p2))
      )
    )
    ((and (wcmatch etype1 "*POLYLINE") (wcmatch etype2 "*POLYLINE"))
      (setq ipt (ipt2pl e1 e2))
    )
    ((and (wcmatch etype1 "*POLYLINE") (wcmatch etype2 "ARC,CIRCLE"))
      (setq ipt (ipt_apl e2 e1))
    )
    ((and (wcmatch etype2 "*POLYLINE") (wcmatch etype1 "ARC,CIRCLE"))
      (setq ipt (ipt_apl e1 e2))
    )
  ) 
  ipt
)
;;;
(defun ppssetcfg(strvar strv)
  (setcfg (strcat "AppDATA/Hongye/PPS/" (strcase strvar)) strv)
)
(defun ppsgetcfg(strvar / retv)
  (setq retv (getcfg (strcat "AppDATA/Hongye/PPS/" (strcase strvar))))
  (if (null retv) (setq retv ""))
  retv
)

(defun &vec_cir(pt dn num color xz / dt p1 p2 ang )
	(if xz (progn
		(setq dn (getvar "viewsize") dn (/ dn 10.0))
	))
	(setq dt (/ (* pi 2.0) num))
	(setq p1 (polar pt 0.0 (* dn 0.5)) ang 0.0)
	(repeat num
	(setq p2 (polar pt (+ ang dt) (* dn 0.5)) )
	(grdraw p1 p2 color)
	(setq p1 p2 ang (+ ang dt))
	)
	(if xz (progn
		(setq p1 (polar pt (* pi 0.25) (* dn 0.5)))
		(grdraw pt p1 color)
		(grdraw pt (polar pt (* pi 0.11) (* dn 0.18)) color)
		(grdraw pt (polar pt (* pi 0.389) (* dn 0.18)) color)
	))
)    ;end of defun
;
;
