(defun &pp_tqzhpxb(envar / w_glb w_ss w_dlnm w_ent w_zhn w_roadn w_zhnb w_ssdl w_fprm w_bprm
       w_sele w_zhn w_roadn w_lnkb lay_nam )
  (#ppls "hy_dlzh")
  (zh_get_dimcfg)
  (if (null pub_save_var)
    (#ppls "wwpublic")
  )
  (if (null $p_to_e)
    (#ppls "pppp")
  )
  (pub_save_var)
  (if envar
    (progn
    (setq w_zhn   (zh_get_zhn envar))
    (if (and w_zhn (= (substr w_zhn 1 4) "GDZH"))
      (setq lay_nam "SW*")
      (setq lay_nam "AXIS")
    )
    (setq w_glb (list (cons 8 lay_nam) (list -3 (list w_zhn))) )
    (setq w_ssdl (ssget "X" w_glb))
   )
    (progn
	  (setq w_glb '((8 . "AXIS") (-3 ("DLZH_*"))))
	;;;判断图中有几条桩线	
	  (setq w_ss (ssget "x" w_glb))
	  (if (null w_ss)
	    (progn
	      (setq w_dlnm 0)
	    )
	    (progn
	      (while (> (sslength w_ss) 0)
					(setq w_ent   (ssname w_ss 0)
					      w_zhn   (zh_get_zhn w_ent)
					      w_roadn (zh_get_roadn w_ent)
					)
					(ssdel w_ent w_ss)
					(if (not (member w_zhn w_zhnb))
					  (setq w_zhnb (cons w_zhn w_zhnb))
					)
	      )
	      (setq w_dlnm (length w_zhnb))
	    )
	  )
	;;;得到要自动定义的桩线的选择集w_ssdl	
	  (cond
	    ((= w_dlnm 0) (setq w_ssdl nil))
	    ((= w_dlnm 1) (setq w_ssdl (ssget "x" w_glb)))
	    ((> w_dlnm 1)
	     (setq w_fprm "回车退出 / 点取参照桩号线:")
	     (setq w_bprm "未选中指定实体,请点取已定义桩号的道路中心线:")
	     (setq w_sele ($p_to_e w_fprm w_bprm w_glb 512))
	     (if w_sele
	       (progn
					 (setq w_zhn (zh_get_zhn (car w_sele)))
					 (setq w_roadn (zh_get_roadn (car w_sele)))
					 (setq w_ssdl
						(ssget "x"
						       (list (cons 8 "AXIS") (list -3 (list w_zhn)))
						)
					 )
	       )
	     )
	    )
	  )
	)
    )    ;end of if envar

;;;检查桩线是否连续,返回链表
  (if w_ssdl
    (progn
    	(setq w_lnkb (hy_ss_con w_ssdl w::prec 2))
    )
  )
;;;对链表排序使链表的点序与桩号顺序一致
  (if w_lnkb (progn
    (setq w_lnkb (zh_lnkb_px w_lnkb w::prec))
  ))
  (zh_nil_dimcfg)
  w_lnkb
)    ;end of defun



(defun &pp_zxpx2(envar / wb zh_nam ssx ns ns1 ent biao p1 p2 pm pp1 r_arc an1 an2 xh xh2
       wb_ssx wb_ent ps pe zjz diszh diszh2 z1 z2 lch1 lch2 zhcsb zhcsb2 val_xs  )
  (setq wb_ssx (&pp_tqzhpxb envar))
  (setq zjz nil
        zhcsb nil
  )
  (if wb_ssx (progn
	  (setq zh_nam (zh_get_zhn envar))
    (if (= zh_nam nil)
      (setq zh_nam (caadr (assoc -3 (entget envar '("GDZH*")))) )
    )
	  (setq ns (length wb_ssx) ns1 0)
	  
	  (repeat ns
	   (if (= zjz nil) (progn
	     (setq wb_ent (nth ns1 wb_ssx) ps (car wb_ent) ent (cadr wb_ent) pe (caddr wb_ent) )
	     (setq wb (entget ent (list zh_nam)) )
	     (setq biao (cdr (assoc 1010 (cdadr (assoc -3 wb))))
	           lch1 (car biao) lch2 (cadr biao) diszh (abs (- lch2 lch1))
	     )
	     (cond
	      ((= (cdr (assoc 0 wb)) "LINE")
	       (setq p1 (cdr (assoc 10 wb)) p2 (cdr (assoc 11 wb))
	             diszh2 (pmdist p1 p2)
	       )
	       (if (not (equal diszh diszh2 0.001)) 
	         (setq zjz "C")
	         (progn
	           (if (> (pmdist ps pe) 0.0001)
	             (setq zhcsb (cons (list (list "LINE" ps pe lch1 lch2) (min lch1 lch2)) zhcsb))
	           )
	         )
	       )
	      )
	      ((or (= (cdr (assoc 0 wb)) "POLYLINE") (= (cdr (assoc 0 wb)) "LWPOLYLINE"))
	       (if (<= (pmdist (car (reverse (dw-ypp ent))) ps) 0.005)
                 (setq val_xs 1.0)
	         (setq val_xs lch2   lch2 lch1   lch1 val_xs   val_xs -1.0 )
	       )
	       (setq zhcsb2 (&pl_en_cs ent))
	       (foreach wb zhcsb2
	          (setq lchz (+ lch1 (* (last wb) val_xs)) )
	          (if (= (car wb) "LINE")
	            (setq zhcsb (cons (list (append (reverse (cdr (reverse wb)))
	                                            (list lch1 lchz))
	                                    (min lch1 lchz)
	                              )
	                              zhcsb)
	            )
	            (progn
	             (setq pp1 (cadr wb) p1 (caddr wb) p2 (cadddr wb)
	                   an1 (nth 4 wb) an2 (nth 5 wb) pm (nth 6 wb)
	             )
	             (if (or (> (abs (rem (- (angle p1 p2) (- (angle pp1 pm) (* pi 0.5))) (* pi 2.0))) 6.27)
	                     (< (abs (rem (- (angle p1 p2) (- (angle pp1 pm) (* pi 0.5))) (* pi 2.0))) 0.01)
	                 )
	               (setq wb (list (list "ARC" pp1 p2 p1 an2 an1 lchz lch1) (min lch1 lchz)) )
	               (setq wb (list (list "ARC" pp1 p1 p2 an1 an2 lch1 lchz) (min lch1 lchz)) )
	             )
	             (setq zhcsb (cons wb zhcsb))
	          ) )
	          (setq lch1 lchz )
	       )
	       (if (not (equal lch1 lch2 0.002)) 
	         (setq zjz "C")
	       )
	      )
	      ((= (cdr (assoc 0 wb)) "ARC")
	       (setq pp1 (cdr (assoc 10 wb)) r_arc (cdr (assoc 40 wb))
	             an1 (cdr (assoc 50 wb)) an2 (cdr (assoc 51 wb))
	       )
	       (if (> an1 an2) (setq an2 (+ an2 (* pi 2.0))) )
	       (setq diszh2 (* (- an2 an1) r_arc))
	       (setq an1 (cdr (assoc 50 wb)) an2 (cdr (assoc 51 wb)) )
	       (if (not (equal diszh diszh2 0.001)) 
	        (setq zjz "C")
	        (progn
	         (setq p1 (polar pp1 an1 r_arc) p2 (polar pp1 an2 r_arc) )
	         (if (<= (pmdist p1 ps) 0.005)
	           (setq zhcsb (cons (list (list "ARC" pp1 p1 p2 an1 an2 lch1 lch2) (min lch1 lch2)) zhcsb) )
	           (setq zhcsb (cons (list (list "ARC" pp1 p1 p2 an1 an2 lch2 lch1) (min lch1 lch2)) zhcsb) )
	         )
	       ))
	     ))
	   ))
	   (setq ns1 (+ ns1 1))
	  )
	  (cond
	   ((= zjz "C")
	    (print) (prompt "\n选择道路中心线定桩号后被改过,重定桩号!")
	   )
	  )
	  
	)
    )
  (if zjz
    nil
    (mapcar 'car (lispx zhcsb))
  )
);end of defun
;
;
(defun &cal_ptzh(pt ent / zhcsb wb ptzh ptzhb p1 p2 p01 p11 an1 an2 ang rr
       lch1 lch2 dis1 dis2 dist pc pm bb ptzhj ptzhbj enlx enlx2 p3 p4
       lch11 lch22 p02  )
 (setq ptzhb nil)
 (if (null &pp_zxpx2) (#ppls "&@pp_zxp"))
 (if (= (type ent) 'LIST)
   (setq zhcsb ent)
   (progn
    (setq zhcsb (&pp_zxpx2 ent))
 ) )
 (if zhcsb (progn
   (foreach wb zhcsb
        (setq ptzh nil enlx (car wb))
        (cond
         ((= enlx "LINE")
          (setq p1 (cadr wb) p2 (caddr wb) lch1 (cadddr wb) lch2 (nth 4 wb))
          (setq ang (angle p1 p2) p01 (interss p1 p2 pt (polar pt (+ ang (* pi 0.5)) 1026.0) nil) )
          (if (equal (pmdist p1 p2) 0.0 0.00001)
           t
           (progn
	    (setq
	          dist (pmdist p1 p2) dis1 (pmdist p01 p1) dis2 (pmdist p01 p2)
	    )
	    (cond
	     ((equal dis1 0.0 0.0005)
	      (setq ptzh lch1 dist (pmdist pt p01))
	     )
	     ((equal dis2 0.0 0.0005)
	      (setq ptzh lch2 dist (pmdist pt p01))
	     )
	     ((and (<= dis1 dist) (<= dis2 dist))
	      (setq ptzh (+ lch1 (* (/ dis1 dist) (- lch2 lch1))) dist (pmdist pt p01))
	     )
	    )
	   )
	  )    ;end of if (equal (pmdist p1 p2) 0.0 0.00001)
         )
         ((= enlx "ARC")
          (setq p01 (cadr wb) p1 (caddr wb) p2 (cadddr wb) rr (pmdist p01 p1) an1 (nth 4 wb)
                an2 (nth 5 wb) lch1 (nth 6 wb) lch2 (nth 7 wb) ang (angle p01 pt)
          )
          (setq an1 (rem an1 (* pi 2.0)) an2 (rem an2 (* pi 2.0)) )
          (if (< an1 0.0) (setq an1 (+ an1 (* pi 2.0))) )
          (if (< an2 0.0) (setq an2 (+ an2 (* pi 2.0))) )
          (if (< an2 an1) (setq an2 (+ an2 (* pi 2.0))) )
          (if (< ang an1) (setq ang (+ ang (* pi 2.0))) )
          (setq p11 (calali (polar pt ang 102.6) (polar pt (+ ang pi) 102.6)
                            (list '(0 . "ARC") (cons 10 p01) (cons 50 an1) (cons 51 an2) (cons 40 rr))
                    )
          )
          (if p11 (progn
            (setq p11 (car p11))
            (cond
             ((equal (pmdist p11 p1) 0.0 0.0005)
              (setq ptzh lch1 dist (pmdist pt p11))
             )
             ((equal (pmdist p11 p2) 0.0 0.0005)
              (setq ptzh lch2 dist (pmdist pt p11))
             )
             ((and (>= ang an1) (<= ang an2))
;;;              (setq dist (pmdist p01 p11) dis1 (abs (- lch1 lch2)) ) 02-26-2000 GD
              (setq dist (pmdist pt p11) dis1 (abs (- lch1 lch2)) )
              (if (> ang an1)
                (setq dis2 (* rr (- ang an1)))
                (setq dis2 (* rr (- (+ ang (* pi 2.0)) an1)))
              )
              (setq ptzh (+ lch1 (* (/ dis2 dis1) (- lch2 lch1))) )
            ))
          )) 
         )
        )
        (if ptzh
          (setq ptzhb (cons (list ptzh dist) ptzhb))
        )
   )    ;end of foreach
   (if (= ptzhb nil) (progn
     (setq ptzhb nil bb nil)
     (foreach wb zhcsb
        (setq ptzh nil enlx (car wb))
        (if (and (= enlx "LINE") (= enlx2 "LINE")) (progn
          (setq p1 (cadr wb) p2 (caddr wb) lch1 (cadddr wb) lch2 (nth 4 wb))
          (setq p3 (cadr bb) p4 (caddr bb) lch11 (cadddr bb) lch22 (nth 4 bb))
          (setq an1 (angle p1 p2) an2 (angle p3 p4))
          (if (or (<= (abs (rem (- an1 an2) pi)) 0.00001)
                  (>= (abs (rem (- an1 an2) pi)) 3.14158)
              )
           t
           (progn
            (setq p01 (interss p1 p2 p3 p4 nil))
            (if p01 (progn
            (if (> (pmdist p01 p1) (pmdist p01 p2)) (setq p1 p2 lch1 lch2))
            (if (> (pmdist p01 p3) (pmdist p01 p4)) (setq p3 p4))
            (setq an1 (angle p1 p01) an2 (angle p01 p3))
            (setq p02 (interss p1 p01 p3 (polar p3 (+ an1 (* pi 0.5)) 1026.0) nil))
            (if p02 (progn
              (setq ang (angle p02 p3))
              (if (or (< (abs (rem (- ang an1) (* pi 2.0))) 0.001)
                      (> (abs (rem (- ang an1) (* pi 2.0))) 6.282)
                  )
               (progn
                (setq an1 (- an1 (* pi 0.5)) an2 (- an2 (* pi 0.5)) )
                (setq ang (angle p01 pt))
                (if (< an1 0) (setq an1 (+ an1 (* pi 2.0))) )
                (if (< an2 0) (setq an2 (+ an2 (* pi 2.0))) )
                (if (< an2 an1) (setq an2 (+ an2 (* pi 2.0))) )
                (setq p02 (calali p01 (polar p01 (angle p01 pt) 102.6)
                                (list '(0 . "ARC") (cons 10 p01) '(40 . 51.3) (cons 50 an1) (cons 51 an2))
                          )
                )
                (if p02 (setq ptzh lch1 dist (pmdist pt p01)) )
  
               ) (progn
                (setq an1 (rem (+ an1 (* pi 0.5)) (* pi 2.0))
                      an2 (rem (+ an2 (* pi 0.5)) (* pi 2.0))
                )
                (if (< an1 an2) (setq an1 (+ an1 (* pi 2.0))) )
                (setq p02 (calali p01 (polar p01 (angle p01 pt) 102.6)
                                  (list '(0 . "ARC") (cons 10 p01) '(40 . 51.3) (cons 50 an2) (cons 51 an1))
                          )
                )
                (if p02 (setq ptzh lch1 dist (pmdist pt p01)) )
              ))
            ))    ;end of if p02
            
            ))
          ))
        ))
        (if (and ptzh (< dist 60.0))
          (setq ptzhb (cons (list ptzh dist) ptzhb))
        )
        (setq bb wb enlx2 enlx)
     )   ;end of foreach
   ))    ;end of if ptzhb
 ))
 (caar (lispx ptzhb))
)    ;end of defun
;
;
(defun &pl_en_cs(s / len loop p1 p2 entb v42 r ang l p0 s etype BH pl_encs pc pm n i)
  (setq	entb  (entget s)
	etype (cdr (assoc 0 entb))
        BH (= (cdr (assoc 70 entb)) 1)
        pl_encs nil
  )
  (if (= etype "POLYLINE")
    (progn
      (setq 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)
		  (if (> (pmdist p1 p2) 0.0001)
		   (setq pl_encs (cons (list "LINE" p1 p2 (pmdist p1 p2)) pl_encs))
		  )
                  (progn
 		    (setq ang (* 4.0 (atan (abs v42)))
			  r   (/ (pmdist p1 p2) 2.0 (sin (* 0.5 ang)))
			  l   (* ang r)
                    )
                    (if (> v42 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 pl_encs (cons (list "ARC" pc p1 p2 (angle pc p1) (angle pc p2) pm r v42 l) pl_encs))
                  )
		)
		(setq v42 (cdr (assoc 42 entb))
		      p1  p2
		)
	      )
	    )
	  )
	)
      )
    )
    (progn
;;;lwpolyline
	   (setq n   (cdr (assoc 90 entb))
		 ;i   (##getindex (assoc 10 entb) entb)
		 p1  (cdr (assoc 10 entb))
                 p1   (p# p1)
		 v42 (cdr (assoc 42 entb))
		 ;i   (+ i 4)
		 entb (cdr (member (assoc 10 entb) entb))
		 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 (assoc 10 entb)) p2 (p# p2))
	     )
	     (if (zerop v42)
	       (setq pl_encs (cons (list "LINE" p1 p2 (pmdist p1 p2)) pl_encs))
               (progn
 		    (setq ang (* 4.0 (atan (abs v42)))
			  r   (/ (pmdist p1 p2) 2.0 (sin (* 0.5 ang)))
			  l   (* ang r)
                    )
                    (if (> v42 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 pl_encs (cons (list "ARC" pc p1 p2 (angle pc p1) (angle pc p2) pm r v42 l) pl_encs))
               )
	     )
	     (setq p1  p2
		   v42 (cdr (assoc 42 entb))
		   ;i   (+ i 4)
		   n   (1- n)
		   entb (cdr (member (assoc 10 entb) entb))
	     )
	   )
    )
  )
  (reverse pl_encs)
)    ;end of defun
;
;
