(defun $pt2ss (pt flst / pt ss ssl i ei ppb ss1)
  (setq	pt  (p# pt)
	ss  ($ptoe pt flst)
	ss1 (ssadd)
  )
  (if ss
    (progn
      (setq ssl	(sslength ss)
	    i	0
	    ss1	(ssadd)
      )
      (repeat ssl
	(setq ei  (ssname ss i)
	      ppb (mapcar 'p# (bg-ypp ei))
	)
	(if (or (equal pt (car ppb) 0.01) (equal pt (cadr ppb) 0.01))
	  (ssadd ei ss1)
	)
	(setq i (1+ i))
      )
    )
  )
  ss1
)

;;;global variable   angle11  dist11 dist22 jlength1 angle3
(defun rxhd (/	      p1       p2	p3	 p4	  angle1
	     angle2   angle4   angle22	angle21	 el	  ell
	     n	      dist1    dist2	pfirst	 psencond jlength
	     jlength2 jxlength str	plwid	  drawbx
	     uctr     loop     olddrawbx	 ptem	
	    )
  (setvar "CMDECHO" 0)
  (setvar "BLIPMODE" 0)
  (setq plwid (/ (DL_GetLayerLineWidth "PP-DL-RXHD") (DL_GetDrawingFactor)))
  (DL_MakeLayer "PP-DL-RXHD")
  (setq	drawbx	  (ppsgetcfg "hysz_rxhd_drawbx")
	olddrawbx drawbx
  )
  (if (or (= drawbx "") (= drawbx nil))
    (setq drawbx "N")
  )
  (initget "Y N")
  (if (= drawbx "N")
    (progn
      (setq p1 (getkword "\n选择: 绘制两侧边线Y /<不绘两侧边线>:"))
      (if (= p1 "Y")
	(setq drawbx "Y")
      )
    )
    (progn
      (setq p1 (getkword "\n选择: 不绘两侧边线N /<绘制两侧边线>:"))
      (if (= p1 "N")
	(setq drawbx "N")
      )
    )
  )
  (setq	loop t
	uctr (HY_ClearUNDO)
  )
  (while loop
    (setq angle4 nil
	  jlength2 nil
    )
    (initget "U")
    (setq p1 (getpoint "\n回车退出 /回退U /输入人行横道线起点:"))
    (cond
      ((null p1) (setq loop nil))
      ((= p1 "U")
       ($undob uctr)
      )
      (t
       (initget 1)
       (setq p2 (getpoint p1 "\n输入人行横道线终点:"))
       (if (< (pmdist p1 p2) 1.0)
	 (prompt "\n起点与终点距离太短!")
	 (progn
	   (initget (+ 2 4))
	   (if (null dist11)
	     (setq dist11 5.0)
	   )
	   (setq dist1
		  (getdist p1
			   (strcat "\n输入横道线宽度<" (rtos dist11 2 2) ">:")
		  )
	   )
	   (if (= dist1 nil)
	     (setq dist1 dist11)
	     (setq dist11 dist1)
	   )
	   (setq angle2 (angle p1 p2))
	   (initget "X")
	   (setq
	     ptem (getpoint
		    p1
		    "\n回车与长度方向垂直 /选择平行线X /输入宽度方向:"
		  )
	   )
	   (cond
	     ((= ptem nil)
	      (setq angle1 (+ angle2 (* pi 0.5)))
	     )
	     ((= ptem "X")
	      (setq angle1 (&tpxx_ang "\n选择平行线:"))
	     )
	     (t
	      (setq angle1 (angle p1 ptem))
	     )
	   )
	   (setq dist2 (pmdist p1 p2))
	   (if (null jlength1)
	     (setq jlength1 0.5)
	   )
	   (setq xh t)
	   (while xh
	     (initget (+ 2 4))
	     (setq jlength (getreal (strcat "\n输入横道线间距<"
					    (rtos jlength1 2 2)
					    ">:"
				    )
			   )
	     )
	     (if (> jlength dist2)
	       (prompt "\n线间距须大于起点与终点长度,重输.")
	       (progn
		 (if (null jlength)
		   (setq jlength jlength1)
		   (setq jlength1 jlength)
		 )
		 (setq jlength2	jlength
		       xh	nil
		 )
	       )			;end of progn
	     )				; end of if 
	   )				;end of while xh
	   (setq pa (polar p1 angle1 (* dist1 0.5))
		 pb (polar p1 angle1 (* dist1 -0.5))
	   )
	   (setq p1 pa
		 p2 pb
		 p3 (polar p1 angle2 dist2)
		 p4 (polar p2 angle2 dist2)
	   )
	   (HY_UndoM)
	   (HY_SV)
	   (if (= drawbx "Y")
	     (command "line" p1 p3 p4 p2 "c")
	     (progn
	       (command "line" p1 p2 "")
	       (command "line" p3 p4 "")
	     )
	   )
	   (setq angle21 (- angle2 angle1))
	   (setq jxlength (/ jlength (abs (sin angle21))))
	   (setq pfirst (polar p1 angle2 jxlength))
	   (setq psencond (polar p2 angle2 jxlength))
	   (command "pline" p1 "w" plwid "" p2 "")
	   (setq el (entlast))
	   (command "change" el "" "p" "c" 5 "")
	   (command "pline" p3 "w" plwid "" p4 "")
	   (setq ell (entlast))
	   (setq n 0)
	   (while (>= (pmdist p1 p3) (pmdist p1 pfirst))
	     (setq n (+ n 1))
	     (if (zerop (rem n 5))
	       (progn
		 (command "pline" pfirst "w" plwid "" psencond "")
		 (setq el (entlast))
		 (command "change" el "" "p" "c" 5 "")
	       )
	       (command "pline" pfirst "w" plwid "" psencond "")
	     )				;end of if  
	     (setq pfirst (polar pfirst angle2 jxlength))
	     (setq psencond (polar psencond angle2 jxlength))
	   )				;end of while
	   (HY_RV)
	 )
       )				;end of if pmdist p1 p2
      )
    )					;end of cond
  )					;end of while loop
  (if (/= drawbx olddrawbx)
    (setq drawbx (ppssetcfg "hysz_rxhd_drawbx" drawbx))
  )
  (setvar "BLIPMODE" 1)
  (setvar "CMDECHO" 1)
  (princ)
)					;end of defun
(defun &tpxx_ang (cc / xh ent2 biao p11 p22 ang)
  (setq xh t)
  (while xh
    (setq ent2 (gpsseld '((0 . "LINE")) cc nil))
    (cond
      ((or (= ent2 nil) (= ent2 "")) t)
      (t
       (setq p01  (cadr ent2)
	     ent2 (car ent2)
	     biao (entget ent2)
       )
       (setq p11 (cdr (assoc 10 biao))
	     p22 (cdr (assoc 11 biao))
	     p11 (list (car p11) (cadr p11) 0.0)
	     p22 (list (car p22) (cadr p22) 0.0)
       )
       (setq ang (angle p11 p22)
	     xh	 nil
       )
      )
    )
  )					;end of while xh
  ang
)					;end of defun

;;;提取 edit_box 的参数
(defun cenum ()
  (setq water_num (get_tile "water_h"))
  (setq cen_num_d (get_tile "dia"))
  (setq cen_num_w (get_tile "wid"))
  (if (= cir_rec "circle")
    (setq cen_num cen_num_d)
    (setq cen_num (strcat cen_num_w "x" cen_num_d))
  )
)
;;;容错处理
(defun chk_ok (/ ok_num)
  (setq ok_num T)
  (cond	((or (chknum (list 0 100) cen_num_d)
	     (zerop (distof cen_num_d 2))
	 )
	 (if (= cir_rec "circle")
	   (set_tile "error" "直径参数输入无效.请重输!")
	   (set_tile "error" "高度参数输入无效.请重输!")
	 )
	 (setq ok_num nil)
	)
	((and (or (chknum (list 0 100) cen_num_w)
		  (zerop (distof cen_num_w 2))
	      )
	      (= cir_rec "rectg")
	 )
	 (set_tile "error" "宽度参数输入无效.请重输!")
	 (setq ok_num nil)
	)
	((not (numberp (distof water_num 2)))
	 (set_tile "error" "底标高参数输入无效.请重输!")
	 (setq ok_num nil)
	)
  )
  ok_num
)

;;;标注文本参数
;;;扩展数据
;;;1998.08.14
(defun cgr (/ what uctr xz #chkcg_ok drawcg scltimg)
  (HY_Set0)
;;; sub fun
  (defun #chkcg_ok (/ ok)
    (setq ok t)
    (setq l (get_tile "L")
	  b (get_tile "b")
	  a (get_tile "a")
	  c (get_tile "c")
    )
    (cond
      ((chknum 0 l)
       (beep)
       (set_tile "error" "L参数无效!")
       (mode_tile "L" 2)
       (setq ok nil)
      )
      ((chknum 0 b)
       (beep)
       (set_tile "error" "b参数无效!")
       (mode_tile "b" 2)
       (setq ok nil)
      )
      ((chknum 0 c)
       (beep)
       (set_tile "error" "车位数量参数无效!")
       (mode_tile "c" 2)
       (setq ok nil)
      )
      ((and (chknum 0 a) (= xz 1))
       (beep)
       (set_tile "error" "a参数无效!")
       (mode_tile "a" 2)
       (setq ok nil)
      )

    )
    ok
  )

  (defun scltimg ()
    (if	(= xz 1)
      (progn
	(mode_tile "img1" 2)
	(mode_tile "a" 0)
      )
      (if (= xz 2)
	(progn
	  (mode_tile "img2" 2)
	  (mode_tile "a" 1)
	)
	(progn
	  (mode_tile "img3" 2)
	  (mode_tile "a" 1)
	)
      )
    )
  )

;;;1998.08.08
  (defun drawcg	(/     ent   ent1  ent2	 ent3  entb  p0	   p1	 p2
		 p3    p4    bp1   bp2	 bp3   bp4   bp5   cp1	 cp2
		 cp3   cp4   cp5   cp6	 pt    pt1   pt2   ipt	 pi2
		 loop  val   s1	   w1	 w2    ang   ang1  ang2	 e1
		 aa    int1  int2  cp1_1 cp2_2 cp3_3 tg	   ctg	 yj
		 draw1
		)
    (defun tg (a /)
      (if (= (cos (dtor a)) 0)
	(print "\n tg为无穷大!")
	(/ (sin (dtor a)) (cos (dtor a)))
      )
    )
    (defun ctg (a /)
      (if (= (sin (dtor a)) 0)
	(print "\n ctg为无穷大!")
	(/ (cos (dtor a)) (sin (dtor a)))
      )
    )

    (defun yj (bp1 bp2 / e1 e2 b1 b2 r1 a1)
      (setq s1 ($pt2ss bp1 '((0 . "LINE") (8 . "ROAD"))))
      (setq ent1 (ssname s1 0)
	    ent2 (ssname s1 1)
      )
      (setq e1 (cdr (assoc 10 (entget ent1)))
	    e2 (cdr (assoc 11 (entget ent1)))
      )
      (if (> (pmdist bp1 e1) (pmdist bp1 e2))
	(setq b1 e1)
	(setq b1 e2)
      )
      (setq e1 (cdr (assoc 10 (entget ent2)))
	    e2 (cdr (assoc 11 (entget ent2)))
      )
      (if (> (pmdist bp1 e1) (pmdist bp1 e2))
	(setq b2 e1)
	(setq b2 e2)
      )
      (zm2pt b1 b2)
      (setq r1 (HY_js_f_max ent1 b1 ent2 b2))
      (if (>= r1 9)
	(command ".fillet" "r" 9)
	(command ".fillet" "r" (- r1 0.1))
      )
      (command ".fillet" ent1 ent2)
      (setq a1 (entlast))

      (setq pt1 (polar bp2 (angle ipt pt) (cadr val)))
      (setq s1 ($pt2ss pt1 '((0 . "LINE") (8 . "ROAD"))))
      (setq ent1 (ssname s1 0)
	    ent2 (ssname s1 1)
      )

      (setq p1 (cdr (assoc 10 (entget ent1)))
	    p2 (cdr (assoc 11 (entget ent1)))
      )
      (if (< (pmdist bp2 p1) (pmdist bp2 p2))
	(setq p1 p2
	      p2 (cdr (assoc 10 (entget ent1)))
	)
      )
      (setq p3 (cdr (assoc 10 (entget ent2)))
	    p4 (cdr (assoc 11 (entget ent2)))
      )
      (if (< (pmdist bp2 p3) (pmdist bp2 p4))
	(setq p3 p4
	      p4 (cdr (assoc 10 (entget ent2)))
	)
      )

      (if (>= (HY_js_f_max ent1 p1 ent2 p3) 9)
	(progn (command ".fillet" "r" 9)
	       (command ".fillet" ent1 ent2)
	)
	(progn
	  (if (null (ipt_la ent1 a1))
	    (progn
	      (command "erase" ent2 "")
	      (command ".fillet" "r" 9)
	      (command ".fillet" (list a1 p4) (list ent1 p2))
	    )
	    (progn
	      (command "erase" ent1 "")
	      (command ".fillet" "r" 9)
	      (command ".fillet" (list ent2 p4) (list a1 p2))
	    )
	  )
	)
      )
    )

    (setq val (mapcar 'atof cg1:defv))
    (setq loop t)
    (while loop
      (setq ent
	     (HY_SelSingleEnt
	       "\n回车返回/ 退出 E / 回退 U / 车港起点位置(应在直线道路边线上):"
	       "LINE"
	       "ROAD"
	       nil
	       "E U"
	     )
      )
      (cond
	((= ent "E")
	 (setq loop nil
	       what 0
	 )
	)
	((= ent "U")
	 (if (<= (getvar "undomarks") uctr)
	   (prompt "\n已全部回退!")
	   (progn
	     (if (= 13 (getvar "undoctl"))
	       (command ".undo" "e")
	     )
	     (command ".undo" "b")
	   )
	 )
	)
	((null ent) (setq loop nil))
	((= ent "RETURN") (beep) (prompt "\n没选中指定实体!"))
	(t
	 (command "view" "s" "draw1")
	 (setq p0  (cadr ent)
	       ent (car ent)
	 )
	 (setq entb (entget ent))
	 (if (#is_line ent)
	   (progn
	     (setq p1 (cdr (assoc 10 entb))
		   p2 (cdr (assoc 11 entb))
		   p0 (interss p1
			       p2
			       p0
			       (polar p0 (+ (angle p1 p2) (/ pi 2)) 10)
			       nil
		      )
	     )
	     (DL_MakeLayer "ROAD")

;;;平行式-----------------------------

	     (if (= xz 2)
	       (progn
		 (setq
		   aa (+ (* (car val) (cadddr val))
			 (* 3.564 (cadr val))
			 2.1
			 (* 18 (/ (sin (dtor 15)) (cos (dtor 15))))
		      )
		 )
		 (if (< (pmdist p1 p2) aa)
		   (progn
		     (beep)
		     (prompt "\n所选道路太短!")
		   )
		   (progn
		     (initget 1)
		     (setq pt (getpoint p0 "\n点示车港方位:"))
		     (setq ang (angle p1 p2)
			   pi2 (/ pi 2)
			   ipt (intersp	pt
					(polar pt ang 1)
					p0
					(polar p0 (+ ang pi2) 1)
					nil
			       )
			   ang (angle ipt pt)

			   bp1 (polar
				 p0
				 ang
				 (+ 0.05
				    (* 9 (/ (sin (dtor 15)) (cos (dtor 15))))
				 )
			       )
			   bp2 (polar bp1 ang (* 1.732 (cadr val)))
			   bp3 (polar bp2
				      ang
				      (+ 2 (* (car val) (cadddr val)))
			       )
			   bp4 (polar bp3 ang (* 1.732 (cadr val)))
			   bp5 (polar
				 bp4
				 ang
				 (+ 0.05
				    (* 9 (/ (sin (dtor 15)) (cos (dtor 15))))
				 )
			       )

		     )

		     (if (pt_onl p1 p2 bp5)
		       (progn
			 (undo_m)
			 (zm2pt bp1 bp4)
			 (if (> (pmdist bp5 p2) (pmdist p0 p2))
			   (command ".break"
				    (list ent bp1)
				    bp1
				    ".break"
				    (list ent bp2)
				    bp2
				    ".break"
				    (list ent bp3)
				    bp3
				    ".break"
				    (list ent bp4)
				    bp4
			   )
			   (command ".break"
				    (list ent bp4)
				    bp4
				    ".break"
				    (list ent bp3)
				    bp3
				    ".break"
				    (list ent bp2)
				    bp2
				    ".break"
				    (list ent bp1)
				    bp1
			   )
			 )
			 (setq pt1 (midpt bp1 bp2))
			 (setq cp1 (polar pt1 (+ ang pi2) 0.1)
			       cp2 (polar pt1 (- ang pi2) 0.1)
			       pt2 (midpt bp3 bp4)
			       cp3 (polar pt2 (- ang pi2) 0.1)
			       cp4 (polar pt2 (+ ang pi2) 0.1)
			 )
			 (zm2pt cp1 cp4)
			 (initget 1)
			 (setq ipt (interss
				     p1
				     p2
				     pt
				     (polar pt (+ (angle p1 p2) pi2) 1)
				     nil
				   )
			       p2  (polar bp1 (angle ipt pt) (cadr val))
			 )
			 (command ".stretch"	"cp"   cp1    cp2
				  cp3	 cp4	""     ""     bp1
				  p2
				 )

			 (yj bp1 bp2)
			 (yj bp4 bp3)

		       )
		       (progn (beep)
			      (prompt "\n所选道路在指定方向上太短!")
		       )
		     )
		   )
		 )
	       )
	     )

;;;直角式---------------------------------

	     (if (= xz 3)
	       (progn
		 (setq aa (+ (* (cadr val) (cadddr val)) 18.5))
		 (if (< (pmdist p1 p2) aa)
		   (progn
		     (beep)
		     (prompt "\n所选道路太短!")
		   )
		   (progn
		     (initget 1)
		     (setq pt (getpoint p0 "\n点示车港方位:"))
		     (setq ang (angle p1 p2)
			   pi2 (/ pi 2)
			   ipt (intersp	pt
					(polar pt ang 1)
					p0
					(polar p0 (+ ang pi2) 1)
					nil
			       )
			   ang (angle ipt pt)

			   bp1 (polar p0 ang 9)
			   bp2 (polar bp1
				      ang
				      (+ 0.5 (* (cadr val) (cadddr val)))
			       )
			   bp3 (polar bp2 ang 9)
		     )

		     (if (pt_onl p1 p2 bp3)
		       (progn
			 (undo_m)
			 (zm2pt bp1 bp2)
			 (if (> (pmdist bp3 p2) (pmdist p0 p2))
			   (command ".break"
				    (list ent p0)
				    p0
				    ".break"
				    (list ent bp3)
				    bp3
			   )
			   (command ".break"
				    (list ent bp3)
				    bp3
				    ".break"
				    (list ent p0)
				    p0
			   )
			 )

			 (setq pt1 (midpt p0 bp3))
			 (setq cp1 (polar pt1 (- ang pi2) 0.1)
			       cp2 (polar pt1 (+ ang pi2) 0.1)
			 )
			 (zm2pt cp1 cp2)
			 (setq s1 (ssget "f"
					 (list cp1 cp2)
					 '((0 . "LINE") (8 . "ROAD"))
				  )
			 )
			 (setq ent1 (ssname s1 0))
			 (setq
			   ipt (interss
				 p1
				 p2
				 pt
				 (polar pt (+ (angle p1 p2) pi2) 1)
				 nil
			       )
			 )
			 (setq ang1 (angle (p# ipt) (p# pt))
			       cp4  (polar p0 ang1 (car val))
			       cp5  (polar bp3 ang1 (car val))
			 )
			 (command "move" ent1 "" p0 cp4)

			 (setq cp1 (polar p0 ang1 9)
			       cp2 (polar bp1 ang1 9)
			       cp3 (polar cp1 (angle cp1 bp1) 9)
			 )
			 (command "arc" p0 cp3 cp2)
			 (setq ent2  (entlast)
			       cp1_1 (polar bp3 ang1 9)
			       cp2_2 (polar bp2 ang1 9)
			       cp3_3 (polar cp1_1 (angle cp1_1 bp2) 9)
			 )
			 (command "arc" bp3 cp3_3 cp2_2)
			 (setq ent3 (entlast))

			 (if (< (car val) 9)
			   (progn
			     (command "trim" ent1 "" (list ent2 cp2) "")
			     (command "trim" ent2 "" (list ent1 cp4) "")
			     (command "trim"
				      ent1
				      ""
				      (list ent3 cp2_2)
				      ""
			     )
			     (command "trim" ent3 "" (list ent1 cp5) "")
			   )
			 )
			 (if (>= (car val) 9)
			   (progn
			     (setq p3 (cdr (assoc 10 (entget ent1)))
				   p4 (cdr (assoc 11 (entget ent1)))
			     )
			     (if (< (pmdist p3 cp1) (pmdist p4 cp1))
			       (progn
				 (HY_KZSJXZ ent1
					 nil
					 10
					 (polar bp1 ang1 (car val))
				 )
				 (HY_KZSJXZ ent1
					 nil
					 11
					 (polar bp2 ang1 (car val))
				 )
			       )
			       (progn
				 (HY_KZSJXZ ent1
					 nil
					 10
					 (polar bp2 ang1 (car val))
				 )
				 (HY_KZSJXZ ent1
					 nil
					 11
					 (polar bp1 ang1 (car val))
				 )
			       )
			     )
			     (if (> (car val) 9)
			       (progn
				 (command "line"
					  cp2
					  (polar bp1 ang1 (car val))
					  ""
				 )
				 (command "line"
					  cp2_2
					  (polar bp2 ang1 (car val))
					  ""
				 )
			       )
			     )
			   )
			 )
		       )
		       (progn (beep)
			      (prompt "\n所选道路在指定方向上太短!")
		       )
		     )
		   )
		 )
	       )
	     )

;;;斜式-----------------------------------

	     (if (= xz 1)
	       (progn
		 (setq aa (+ (* (cadr val) (cadddr val))
			     1
			     (* 9 (tg (/ (caddr val) 2)))
			     (* 4.5 (ctg (/ (caddr val) 2)))
			  )
		 )
		 (if (< (pmdist p1 p2) aa)
		   (progn
		     (beep)
		     (prompt "\n所选道路太短!")
		   )
		   (progn
		     (initget 1)
		     (setq pt (getpoint p0 "\n点示车港方位:"))
		     (setq ang (angle p1 p2)
			   pi2 (/ pi 2)
			   ipt (intersp	pt
					(polar pt ang 1)
					p0
					(polar p0 (+ ang pi2) 1)
					nil
			       )
			   ang (angle ipt pt)

			   bp1 (polar p0 ang (* 9 (tg (/ (caddr val) 2))))
			   bp2 (polar bp1
				      ang
				      (+ 1 (* (cadr val) (cadddr val)))
			       )
			   bp3 (polar bp2
				      ang
				      (* 4.5 (ctg (/ (caddr val) 2)))
			       )
			   cp1 (polar bp1
				      ang
				      (* (car val) (ctg (caddr val)))
			       )
			   cp2 (polar bp2
				      ang
				      (* (car val) (ctg (caddr val)))
			       )
		     )

		     (if (pt_onl p1 p2 bp3)
		       (progn
			 (undo_m)
			 (zm2pt bp1 bp2)
			 (if (> (pmdist bp3 p2) (pmdist p0 p2))
			   (command ".break"
				    (list ent p0)
				    p0
				    ".break"
				    (list ent bp3)
				    bp3
			   )
			   (command ".break"
				    (list ent bp3)
				    bp3
				    ".break"
				    (list ent p0)
				    p0
			   )
			 )

			 (setq pt1 (polar p0 ang 0.2)
			       pt2 (polar bp3 ang -0.2)

			       cp3 (polar pt1 (- ang pi2) 0.1)
			       cp4 (polar pt1 (+ ang pi2) 0.1)
			       cp5 (polar pt2 (- ang pi2) 0.1)
			       cp6 (polar pt2 (+ ang pi2) 0.1)
			 )
			 (zm2pt cp3 cp6)
			 (setq s1 (ssget "f"
					 (list cp3 cp4 cp6 cp5)
					 '((0 . "LINE") (8 . "ROAD"))
				  )
			 )
			 (repeat (sslength s1)
			   (setq e1 (ssname s1 0))
			   (ssdel e1 s1)
			   (command "erase" e1 "")
			 )

			 (setq
			   ipt (interss
				 p1
				 p2
				 pt
				 (polar pt (+ (angle p1 p2) pi2) 1)
				 nil
			       )
			 )
			 (setq ang1 (angle (p# ipt) (p# pt))
			       cp3  (polar cp1 ang1 (car val))
			       cp4  (polar cp2 ang1 (car val))
			       cp5  (polar p0 ang1 (car val))
			       cp6  (polar bp3 ang1 (car val))
			 )
			 (command "line" cp5 cp6 "")
			 (setq ent1 (entlast))

			 (setq pt1  (polar p0 ang1 9)
			       ang2 (+ (angle bp1 cp3) (dtor 90))
			       int1 (inters bp1
					    cp3
					    pt1
					    (polar pt1 ang2 0.1)
					    nil
				    )
			       pt2  (polar pt1 (angle pt1 bp1) 9)
			 )
			 (command "arc" p0 pt2 int1)
			 (setq ent2 (entlast))

			 (setq pt1  (polar bp3 ang1 4.5)
			       int2 (inters bp2
					    cp4
					    pt1
					    (polar pt1 ang2 0.1)
					    nil
				    )
			       pt2  (polar pt1 (angle pt1 bp2) 4.5)
			 )
			 (command "arc" bp3 pt2 int2)
			 (setq ent3 (entlast))

			 (setq w1  (* (pmdist bp1 int1)
				      (sin (dtor (caddr val)))
				   )
			       w2  (* (pmdist bp2 int2)
				      (sin (dtor (caddr val)))
				   )
			       pt1 (cdr (assoc 10 (entget ent1)))
			       pt2 (cdr (assoc 11 (entget ent1)))
			 )

			 (if (< (car val) w1)
			   (progn
			     (command "trim"
				      ent1
				      ""
				      (list ent2 int1)
				      (list ent3 int2)
				      ""
			     )
			     (command "trim"
				      ent2
				      ent3
				      ""
				      (list ent1 pt1)
				      (list ent1 pt2)
				      ""
			     )
			   )
			   (if (> (car val) w2)
			     (progn
			       (command "line" int1 cp3 "")
			       (setq ent2 (entlast))
			       (command "line" int2 cp4 "")
			       (setq ent3 (entlast))
			       (command	"trim"
					ent2
					ent3
					""
					(list ent1 pt1)
					(list ent1 pt2)
					""
			       )
			     )
			     (progn
			       (command "line" int1 cp3 "")
			       (setq ent2 (entlast))
			       (command	"trim"
					ent1
					""
					(list ent3 int2)
					""
			       )
			       (command	"trim"
					ent2
					ent3
					""
					(list ent1 pt1)
					(list ent1 pt2)
					""
			       )
			     )
			   )
			 )
		       )
		       (progn (beep)
			      (prompt "\n所选道路在指定方向上太短!")
		       )
		     )
		   )
		 )
	       )
	     )

;;;---------------

	   )
	   (setq loop nil)
	 )
	 (command "view" "r" "draw1")
	 (command "view" "d" "draw1")
	)
      )
    )
    (princ)
  )
;;;;

  (setq	what 10
	xz 1
  )
  (setq uctr (HY_ClearUNDO))
;;;8:28 98-12-9
  (if (null road:dcl_id)
    (setq road:dcl_id
           (load_dialog
             (strcat (HY_GetInstallDir)
                     hyszdl_gv_commres_dir
                     "\\"
                     hyszdl_gv_dcl_dir
                     "\\bj_rdbj.dcl"
             )
           )
    )
  )
  (if (> road:dcl_id 0)
    (progn
      (if (null cg1:defv)
	(setq cg1:defv '("3.0" "2.0" "60" "10"))
      )
      (while (> what 0)
	(if (not (new_dialog "cg" road:dcl_id))
	  (exit)
	)
;;;8:28 98-12-9
	(playsld "xs" "img1")
	(playsld "pxs" "img2")
	(playsld "zjs" "img3")
	(if (= xz 1)
	  (progn
	    (mode_tile "img1" 2)
	    (mode_tile "a" 0)
	  )
	)
	(if (= xz 2)
	  (progn
	    (mode_tile "img2" 2)
	    (mode_tile "a" 1)
	  )
	)
	(if (= xz 3)
	  (progn
	    (mode_tile "img3" 2)
	    (mode_tile "a" 1)
	  )
	)
	(action_tile "img1" "(setq xz 1) (scltimg)")
	(action_tile "img2" "(setq xz 2) (scltimg)")
	(action_tile "img3" "(setq xz 3) (scltimg)")

	(mapcar 'set_tile '("L" "b" "a" "c") cg1:defv)
	(action_tile "accept" "(if (#chkcg_ok) (done_dialog 1))")
	(setq what (start_dialog))
	(cond
	  ((= what 1)
	   (setq cg1:defv (list l b a c))
	   (HY_SV)
	   (drawcg)
	   (HY_RV)
	  )
          (t (setq what 0))
	)
      )
    )
  )
;;;8:28 98-12-9
  (HY_Set1)
  (princ)
)
;;;modi 1998.02.02
;;;modi 1998.02.25
;;;modi yft 99.07.03
(defun #hhp (/ p1 p2 y d w pp pa pb p sc ppp k1	l l1 y3	e ss oldvar ent
	     lay)
  (HY_Set0)
  (setq lay "pp-gzw7")
  (DL_MakeLayer lay)
  (if (null dw-ypp)
    (#ppls "pppp")
  )
  (if (null #pline)
    (#ppls "pppp")
  )
  (setq sc (DL_GetDrawingFactor))
  (setq w (/ (DL_GetLayerLineWidth lay) sc))
  (setq l1 5.0)
  (initget 2)
  (setq	l (getreal
	    (strcat "\n长齿长度(相对于前进方向齿在左负,在右正)<"
		    (rtos l1 2 2)
		    ">:"
	    )
	  )
  )
  (if (= l nil)
    (setq l l1)
  )
  (setq l1 l)
  (setvar "plinewid" w)
  (setq e (#pline lay))
  (HY_Set0)
  (if e
    (progn
      (initget "S")
      (setq p1 (getpoint
		 "\n选择护坡界线 S / 回车无界线 / <绘制护坡界线起点:>"
	       )
      )
      (cond
	((= p1 nil)
	 (setq ss nil)
	)
	((= p1 "S")
	 (setq ss (ssget '((0 . "*line,arc,circle"))))
	)
	(t
	 (setq ss  (ssadd)
	       ent (#plinep p1)
	 )
	 (if ent
	   (progn
	     (ssadd ent ss)
	     (command "pedit" ent "w" 0.0 "")
	   )
	 )
	)
      )
      (if (and ss (zerop (sslength ss)))
	(setq ss nil)
      )
      (setvar "clayer" lay)
      (hzhp_1 ss e sc l1)
      (if (and ent (entget ent))
	(entdel ent)
      )
    )
  )
  (HY_Set1)
  (princ)
)
;;;
(defun hzhp_1 (ss    e	   sc	 l1    /     ent   ss1	 entb  p1
	       p2    p3	   p4	 ang   ang1  sca   l	 n     i
	       wid   lastl entl	 ans   ane   pc	   k	 ang2  len
	       sstemp	   mode	 ang3  longl ss2   loop	 op    p
	       ptb   ##trim_line
	      )

  (defun ##trim_line (ent    /	    ptb	   n	  pt	 pt1	pt2
		      long   sca    bh_syb ep	  sp	 len	loop
		      ptmp1  ptmp2  entss  loop1  n1	 ent1	len1
		      triment	    iptb   maxdis maxpt
		     )
    (if	(null $pfj)
      (#ppls "pppp")
    )
    (setq sca  (DL_GetDrawingFactor)
	  ptb  (bg-ypp ent)
	  len  (length ptb)
	  long (/ 500.0 sca)
	  loop t
	  n    0
    )
    (if	(= (cdr (assoc 70 (entget ent))) 1)
      (setq bh_syb t)
    )
    (while (and loop (< n len))
      (if bh_syb
	(cond
	  ((= n 0)
	   (setq pt  (nth n ptb)
		 pt1 (last ptb)
		 pt2 (nth (1+ n) ptb)
	   )
	  )
	  ((= n (1- len))
	   (setq pt  (nth n ptb)
		 pt1 (car ptb)
		 pt2 (nth (1- n) ptb)
	   )
	  )
	  (t
	   (setq pt  (nth n ptb)
		 pt1 (nth (1- n) ptb)
		 pt2 (nth (1+ n) ptb)
	   )
	  )
	)
	(if (or (= n 0) (= n (1- len)))
	  (setq pt nil)
	  (setq	pt  (nth n ptb)
		pt1 (nth (1- n) ptb)
		pt2 (nth (1+ n) ptb)
	  )
	)
      )

      (if pt
	(progn
	  (setq	ptmp1 ($pfj pt pt1 pt2)
		ptmp2 (polar pt (angle pt ptmp1) long)
	  )
	  (zm2pt pt ptmp2)
	  (setq	entss (ssget "f"
			     (list pt ptmp2)
			     '((0 . "LINE") (8 . "PP-GZW7"))
		      )
	  )
	  (if entss
	    (progn
	      (command ".line" pt ptmp2 "")
	      (setq triment (entlast)
		    iptb    (ipt_ess triment entss)
		    maxpt   nil
	      )

	      (setq maxdis 0.0)
	      (foreach n1 iptb
		(if (> (pmdist pt (car n1)) maxdis)
		  (progn
		    (setq sp (cdr (assoc 10 (entget (cadr n1))))
			  ep (cdr (assoc 11 (entget (cadr n1))))
		    )
		    (if	(or (pt_onl pt1 pt sp)
			    (pt_onl pt2 pt sp)
			    (pt_onl pt1 pt ep)
			    (pt_onl pt2 pt ep)
			)
		      (setq maxdis (pmdist pt (car n1))
			    maxpt  (car n1)
		      )
		    )
		  )
		)
	      )
	      (if maxpt
		(command ".line" pt maxpt "")
	      )

	      (setq loop1 t
		    n1	  0
		    len1  (sslength entss)
	      )
	      (while (and loop1 (< n1 len1))
		(setq ent1 (ssname entss n1)
		      sp   (cdr (assoc 10 (entget ent1)))
		      ep   (cdr (assoc 11 (entget ent1)))
		)
		(if (or (pt_onl pt1 pt sp) (pt_onl pt2 pt sp))
		  (progn
		    (command ".trim" triment "" (list ent1 ep) "")
		  )
		  (if (or (pt_onl pt1 pt ep) (pt_onl pt2 pt ep))
		    (command ".trim" triment "" (list ent1 sp) "")
		  )
		)
		(setq n1 (1+ n1))
	      )
	      (if (and triment (entget triment))
		(entdel triment)
	      )
	    )
	  )
	)
      )

      (setq n (1+ n))
    )
    (if	(and triment (entget triment))
      (entdel triment)
    )
    (princ)
  )

  (HY_SV)
  (setq	sca (/ 1.0 sc)
	l   (* sca l1)
	wid (* 4 sca)
;;;modi yft 99.07.03
  )
  (if (null ss)
    (if	(> l 0)
      (setq ang2 (/ pi -2))
      (setq ang2 (/ pi 2)
	    l	 (abs l)
      )
    )
  )
  (command ".copy" e "" "0,0,0" "0,0,0")
  (setq	ent (entlast)
	ss1 (ssadd)
  )

;;;modi yft 99.07.03
  (if (= (cdr (assoc 70 (entget ent))) 1)
    (setq ptb (reverse (dw-ypp ent))
	  ptb (append ptb (list (car ptb)))
    )
    (setq ptb (reverse (dw-ypp ent)))
  )

  (command ".explode" ent)
  (while (setq ent (entnext ent))
    (ssadd ent ss1)
  )
  (setq i 0)
  (repeat (sslength ss1)
    (setq ent  (ssname ss1 i)
	  entb (entget ent)
	  p1   (nth i ptb)
	  p2   (nth (1+ i) ptb)
	  ang  (angle p1 p2)
    )
;;;-----------------------
;;;get direction    
    (if	ss
      (progn
	(setq p3 (midpt p1 p2)
	      p4 (polar p3 (+ ang (/ pi 2)) 60)
	)
	(setq sstemp (ssget "cp" (list p3 p2 p4)))
	(if sstemp
	  (progn
	    (setq k   0
		  len (sslength sstemp)
	    )
	    (while (and (null ang2) (< k len))
	      (if (ssmemb (ssname sstemp k) ss)
		(setq ang2 (/ pi 2))
	      )
	      (setq k (1+ k))
	    )
	  )
	)
      )
    )

    (if	(null ang2)
      (setq ang2 (/ pi -2))
    )
;;;-----------------------
    (cond
      ((= (cdr (assoc 0 entb)) "LINE")
       (setq n (fix (/ (pmdist p1 p2) wid))
       )

       (setq ang1 (+ ang ang2))

       (setq longl t)
       (repeat n
	 (setq p1 (polar p1 ang wid)
	       p2 (polar p1 ang1 0.1)
	 )
	 (if longl
	   (if ss
;;;1
	     (progn
	       (setq longl nil)
	       (command	".line"
			p1
			p2
			""
			".extend"
			ss
			""
			(list (entlast) p2)
			""
	       )
	       (setq entb  (entget (entlast))
		     p3	   (cdr (assoc 10 entb))
		     p4	   (cdr (assoc 11 entb))
		     lastl (distance p3 p4)
	       )
	       (if (equal lastl 0.1 0.001)
				 (progn
				   (setq lastl l)
				   (command ".line" p1 (polar p1 ang1 lastl) "")
				 )
	       )
	     )
	     (progn
	       (command ".line" p1 (polar p1 ang1 l) "")
	       (setq lastl l
		     longl nil
	       )
	     )
	   )
;;;end of if ss ;;;1
	   (progn
	     (setq longl t)
	     (setq lastl (* 0.4 lastl))
	     (command ".line" p1 (polar p1 ang1 lastl) "")
	   )
	 )

       )
      )
      ((= (cdr (assoc 0 entb)) "ARC")
       (setq ans   (cdr (assoc 50 entb))
	     ane   (cdr (assoc 51 entb))
	     r	   (cdr (assoc 40 entb))
	     ang   (/ wid r)
	     pc	   (cdr (assoc 10 entb))
;;;center
	     mode  nil
	     longl t
	     loop  t
	     p	   (* r (- ane ans))
	     op	   +
       )
       (if (< p 0)
	 (setq p (+ (* 2 pi r) p))
;;;arc length
       )
       (setq n (fix (/ p wid)))

       (setq ang1 (op ans ang)
	     p3	  (polar pc ang1 r)
	     ang3 (if mode
		    (+ ang1 pi)
		    ang1
		  )
	     p4	  (polar p3 ang3 0.1)
       )
       (if (setq ss2 (ssget "f" (list (polar p3 (+ ang1 pi) 1) p4)))
	 (if (null (ssmemb ent ss2))
	   (setq op -)
	 )
       )
       (setq ss2 nil)

       (if (not	(eq_ang	(+ (angle p1 p2) ang2)
			(+ (angle (polar pc ans r) (polar pc ane r))
			   (/ pi -2)
			)
		)
	   )
	 (setq mode t)
       )
       (repeat n
	 (setq ang1 (op ans ang)
	       p1   (polar pc ang1 r)
	       ang3 (if	mode
		      (+ ang1 pi)
		      ang1
		    )
	       p2   (polar p1 ang3 0.1)
	 )
	 (setq ans ang1)
	 (if longl
	   (if ss
;;;2
	     (progn
	       (setq longl nil)
	       (command	".line"
			p1
			p2
			""
			".extend"
			ss
			""
			(list (entlast) p2)
			""
	       )
	       (setq entb  (entget (entlast))
		     p3	   (cdr (assoc 10 entb))
		     p4	   (cdr (assoc 11 entb))
		     lastl (distance p3 p4)
	       )
	       (if (equal lastl 0.1 0.001)
		 (progn
		   (setq lastl l)
		   (command ".line" p1 (polar p1 ang3 lastl) "")
		   (setq entb  (entget (entlast))
			 p3    (cdr (assoc 10 entb))
			 p4    (cdr (assoc 11 entb))
			 lastl (distance p3 p4)
		   )
		 )
	       )
	     )
	     (progn
	       (command ".line" p1 (polar p1 ang3 l) "")
	       (setq lastl l
		     longl nil
	       )
	     )
	   )
;;; end of if ss ;;;2
	   (progn
	     (setq longl t)
	     (setq lastl (* 0.4 lastl))
	     (command ".line" p1 (polar p1 (op ang3 ang) lastl) "")
	   )
	 )
       )
      )
    )
;;; end of cond
    (setq i (1+ i))
  )
;;;end of repeat
  (command ".erase" ss1 "")
  (##trim_line e)
  (redraw e 4)
  (HY_RV)
)
;;;modi 1998.06.13
;;;modi 98.12.5 yft
(defun dw-gzw8 (/ y w w0 pp sc l l1)
  (HY_Set0)
  (if (null #pline1)
    (#ppls "pppp")
  )
  (setq sc (DL_GetDrawingFactor))
  (setq w0 (/ (DL_GetLayerLineWidth "pp-gzw8") sc))
  (setq w (/ (DL_GetLayerLineWidth "pp-gzw81") sc))

  (setq l1 4.0)
  (setq y t)
  (while y
    (initget 2)
    (setq l (getreal
	      (strcat "\n齿长度.方向(相对于前进方向齿在左负,在右正)<"
		      (rtos l1 2 2)
		      ">:"
	      )
	    )
    )
    (if	(= l nil)
      (setq l l1)
    )
    (setq l1 l)
    (if	(setq ppp (#pline2 "PP-gzw8"))
      (progn
				(dw-gzw82 (entlast) ppp sc l w)
      )
      (setq y nil)
    )
  )
  (HY_Set1)
  (princ)
)
(defun dw-gzw82	( ent ppp sc dd w / n l p1 p2 a a1 pa pb pc y pd ptb parameter bulge radius pc)

  (DL_MakeLayer "pp-gzw81")
  (setvar "plinewid" w)
  (setq ppp (reverse ppp))
  (setq n 0)
  (setq l (/ (abs dd) sc))
  (foreach ptb ppp
  	(cond 
  		( (= (length ptb) 2)
  			(setq p1 (nth 0 ptb))
		    (setq p2 (nth 1 ptb))
		    (setq a (angle p1 p2))
		
		    (if	(> dd 0)
		      (setq a1 (- a (/ pi 2)))
		      (setq a1 (+ a (/ pi 2)))
		    )
		    (setq pb (polar p1 a1 (/ 0.35 sc)))
		    (setq pc (polar pb a l))
		    (command "pline" pb pc "")
		    (setq y t)
		    (while y
		      (setq pb (polar pc a l))
		      (setq pc (polar pb a l))
		      (setq pd (polar pc (+ a1 pi) (/ 0.35 sc)))
		      (if (equal (angle p1 pd) (angle pd p2) 0.01)
							(command "pline" pb pc "")
							(setq y nil)
		      )
		    )
  		)
  		((= (length ptb) 3)
  			(setq sp (nth 0 ptb))
  			(setq ep (nth 2 ptb))
  			(setq bulge (last (dw-ypp1 ent (cadr ptb))))
  			(setq parameter (parc_pcr sp ep bulge))
  			(setq pc (car parameter))
  			(setq radius (cadr parameter))

  			(setq p0 sp )
  			(setq p1 (nth 1 ptb))
  			(setq p5 ep)
  			(draw_yy (/ dd  sc) w sp (nth 1 ptb) ep)
  		)
  			
  	)
    
  )
)
(defun draw_yy (l wid sp mp ep / ent1 ent2  entb ans ane n ang ang3 ang4 
								r pc p p1  p2 p3 e pts sp ep angle1 angle2  spt ept 
								intp ptem temp flag ver lef_rig)
	(#ppls "bj_rdbj")
	 
  (command ".arc" sp mp ep)
  (setq lef_rig (left_right sp ep mp))
  (setq	ent1 (entlast)
	entb (entget ent1)
  )
  (if ( > l 0)
  	(setq flag 1)
  	(setq flag -1)
  )
  (setq l (abs l))
  (if plwid
    (command ".pedit" ent1 "" "w" plwid "")
  )
  (setq l (* 2.0 l))
  (setq	ans (cdr (assoc 50 entb))
				ane (cdr (assoc 51 entb))
				r   (cdr (assoc 40 entb));;半径
				pc  (cdr (assoc 10 entb))
				p1  (polar pc ans r);;起始点
				p2  (polar pc ane r);;结束点
				p   (* r (abs(- ane ans)))
  )
	(if (null (pt_on_ent (polar pc (/ (+ ans ane) 2.0) r) ent1))
		(progn
			(setq p (- (* r 2 pi ) p))
		)
	)
  (setq	n    (fix (/ p l))
				p    (* n l)
				ang3 (* 180 (/ (/ p r) pi))
  )
;;  (if (< ans ane)
;;  	(progn
;;  		(setq temp ans)
;;  		(setq ans ane)
;;  		(setq ane temp)
;;  	)
;;  )
  (setq	ang4 (* (/ (* 0.5 l) r) 0.5 )
				ang  (+ ans ang4)
				p1   (polar pc ans r)
				p2   (polar pc ang r)
				ang  (+ ang ang4)
				p3   (polar pc ang r)
  )
  (if (null (pt_on_ent p2 ent1))
  	(progn
  		(setq	ang4 (* (/ (* 0.5 l) r) 0.5)
				ang  (- ans ang4)
				p1   (polar pc ans r)
				p2   (polar pc ang r)
				ang  (- ang ang4)
				p3   (polar pc ang r)
  		)	
  	)
  )
  (if (> (distance p1 sp) (distance p1 ep))
  	(progn
  		(progn
  			(setq ptem sp)
  			(setq sp ep)
  			(setq ep ptem)
  		)
  	)
  )
  (DL_MakeLayer lay1)
  (command "line" p1 p2 p3 "")
  (command ".arc" p1 p2 p3)
  
  (command ".pedit" (entlast) "" "w" wid "")

	(if ( > lef_rig 0)
		
		(progn
				(command ".move"
		     (entlast)
		     ""
		     p2
		     (polar p2 (angle  p2 pc) (* 0.5 wid flag))
	    )
		)
		(progn
			(command ".move"
		     (entlast)
		     ""
		     p2
		     (polar p2 (angle  pc p2) (* 0.5 wid flag))
	    )
		)
	)
	
  (if (> n 1)
    (command ".array"
	     (list (entlast) p1)
	     ""
	     "p"
	     pc
	     (1+ n)
	     ang3
	     "y"
    )
  )
  (setq e (entlast))
  (setq pts (bg-ypp e))
  (if pts 
  	(progn
  			(setq spt (car pts))
  			(setq ept (last pts))
  			;;(if (< ( * (left_right sp ep mp)  (left_right sp ep spt)) 0) ;;(> (abs (- (angle pc spt)(angle pc sp))) (abs (- (angle pc ept)(angle pc sp))))
  			;;(setq vv1 (left_right sp ep mp))
  			;;(setq vv2 (left_right sp ep spt))
  			(if (< (* (left_right sp ep mp) (left_right sp ep spt)) 0)
  				(progn
  					(setq spt (last pts))
  					(setq ept (car pts))
  				)
  			)
  			(setq angle1 (angle pc spt))
  			(setq angle2  (angle pc ept))  	

  			(if (< (* (- ans angle1) (- angle1 ane)) 0)
  				(progn
  					(setq intp (inters pc (polar ep (angle pc ep) (* 2 wid)) spt ept ))
  					(if intp
  						(progn
  							(command "break" (list e intp) ept )
  						)
  					)
  				)
  			)
  			(if (< (* (- ans angle2) (- angle2 ane)) 0)
  				(progn
  					(setq intp (inters pc (polar ep (angle pc ep) (* 2 wid)) spt ept ))
  					(if intp
  						(progn
  							(command "break" (list e intp) ept )
  						)
  					)
  				)
  			)
  	)
  )
  
  (entdel ent1)
)
;;;modi 1998.02.25
;;;modi 1998.03.09
;;;modi 1998.06.11
(defun #dtq_arc	(/     ptb1  ptb2  ang	 ent   w     ent1  ent2	 ss
		 n     ipt   k	   bzfw	 glb   lay   ename1	 ename2
		 entb1 entb2 p0	   p1	 p2    p3    p4	   p5	 ang1
		 ang2  plwid pi/2  pc	 f1    f2    f3	   pa	 tq1
		 tq2   entb  lay1
		)
  (HY_Set0)
  (setq	lay  "PP-GZW8"
	lay1 "PP-GZW81"
	glb  (list (cons 0 "*POLYLINE") (cons 8 lay))
	bzfw 0.5
  )
  (while (= "" (setq ent1 (gpsseld glb "\n请选择挡土墙1:" nil)))
  )

  (if ent1
    (progn
      (setq ename1 (car ent1)
	    entb1  (entget ename1)
	    plwid  (cdr (assoc 41 entb1))
	    ptb1   (dw-lypp1 ename1 (cadr ent1))
      )
      (while (or (not (setq ent2 (gpsseld glb "\n请选择挡土墙2:" nil)))
		 (= ent2 "")
	     )
      )
      (setq ename2 (car ent2)
				    entb2  (entget ename2)
				    ptb2   (dw-lypp1 ename2 (cadr ent2))
      )

      (if (and ptb1 ptb2)
				(progn
			;;;***
			;;;inters pt
				       (setq p0	 (car ptb1)
					     p1	 (cadr ptb1)
					     p2	 (caddr ptb1)
					     p3	 (cadr ptb2)
					     p4	 (caddr ptb2)
					     ipt (interss p1 p2 p3 p4 nil)
				       )
			
				       (if ipt
					 (progn
					   (if (> (pmdist ipt p1) (pmdist ipt p2))
					     (setq ang1 (angle ipt p1))
					     (setq ang1 (angle ipt p2))
					   )
					   (if (> (pmdist ipt p3) (pmdist ipt p4))
					     (setq ang2 (angle ipt p3))
					     (setq ang2 (angle ipt p4))
					   )
					   (setq p5 (polar ipt ang2 (pmdist ipt p0)))
			
					   (setq pi/2 (/ pi 2)
						 pc   (interss p0
							       (polar p0 (+ ang1 pi/2) 10)
							       p5
							       (polar p5 (- ang2 pi/2) 10)
							       nil
						      )
					   )
			
					   (setq f1 (polar p0 (+ ang1 pi/2) 0.2)
						 f2 (polar ipt (angle pc ipt) 0.2)
						 f3 (polar p5 (- ang2 pi/2) 0.2)
					   )
					   (setq ss
						  (ssget "cp"
							 (list f1 f2 f3)
							 (list (cons 0 "*POLYLINE") (cons 8 "PP-GZW81"))
						  )
					   )
					   (if ss
					     (progn
					       (setq ent  (ssname ss 0)
						     entb (entget ent)
					       )
					       (setq pa (car (dw-ypp ent)))
					     )
					   )
			
					   (if pa
					     (setq ss (ssget "f" (list pc pa) glb))
					   )
					   (if (and ss (ssmemb (car ent1) ss))
					     (setq k 1)
					   )
					   (if (and (setq ent1 (nentselp p5))
						    (setq ent2 (nentselp p0))
					       )
					     (progn
					       (setq tq1 (cdr (assoc 42 (entget (car ent1))))
						     tq2 (cdr (assoc 42 (entget (car ent2))))
					       )
					       (if (and tq1 tq2 (zerop tq1) (zerop tq2))
									 (progn
									   (HY_SV)
									   (draw_arc lay plwid)									   
									   (if (equal ename1 ename2)
									     (command ".break" (list ename1 p0) p5)
									     (progn
									       (command ".break" (list ename1 p0) ipt)
									       (command ".break" (list ename2 p5) ipt)
									     )
									   )
									   (HY_RV)
									 )
					       )
					     )
					   )
					 )
				       )
				)
      )
;;;end of ;;;***                                                    
    )
  )
  (HY_Set1)
)
;;;
(defun draw_arc	(lay plwid / r p1 ss1 ang f1 f2	f3 f4 f5 f6 ang	pi/2
		 entb wid ent l	ptb)
  (DL_MakeLayer lay)
  (setq	pi/2 (/ pi 2)
	ang  (angle pc ipt)
	r    (pmdist p0 pc)
	p1   (polar pc ang r)
  )
  (setq	f1 (polar p0 (+ ang1 pi/2) 0.2)
	f2 (polar ipt ang 0.2)
	f3 (polar p5 (- ang2 pi/2) 0.2)
  )
  (setq	f4 (polar p0 (- ang1 pi/2) 0.2)
	f5 (polar ipt (+ ang pi) 0.2)
	f6 (polar p5 (+ ang2 pi/2) 0.2)
  )
  (setq	ss (ssget "f"
		  (list f1 f2 f3 f6 f5 f4 f1)
		  (list (cons 0 "*POLYLINE") (cons 8 "PP-GZW81"))
	   )
  )
  (if ss
    (progn
      (setq ent	 (ssname ss 0)
	    entb (entget ent)
	    wid	 (cdr (assoc 41 entb))
      )
      (setq ptb (dw-ypp ent))
      (setq l (pmdist (car ptb) (cadr ptb)))
    )
  )
  (if ss
    (command ".erase" ss "")
  )
  (draw_yc l wid)
)
;;;
(defun draw_yc (l wid / ent1 entb ans ane n ang ang3 ang4 r pc p p2 p3)
  (command ".arc" p0 p1 p5)
  (setq	ent1 (entlast)
	entb (entget ent1)
  )
  (if plwid
    (command ".pedit" ent1 "" "w" plwid "")
  )
  (setq l (* 2.0 l))
  (setq	ans (cdr (assoc 50 entb))
	ane (cdr (assoc 51 entb))
	r   (cdr (assoc 40 entb))
	pc  (cdr (assoc 10 entb))
	p1  (polar pc ans r)
	p2  (polar pc ane r)
	p   (* r (- ane ans))
  )
  (if (< p 0)
    (setq p (+ p (* 2 pi r)))
  )
  (setq	n    (fix (/ p l))
	p    (* n l)
	ang3 (* 180 (/ (/ p r) pi))
  )
  (setq	ang4 (* (/ (* 0.5 l) r) 0.5)
	ang  (+ ans ang4)
	p1   (polar pc ans r)
	p2   (polar pc ang r)
	ang  (+ ang ang4)
	p3   (polar pc ang r)
  )
  (DL_MakeLayer lay1)
  (command ".arc" p1 p2 p3)
  (command ".pedit" (entlast) "" "w" wid "")

  (if (= k 1)
    (command ".move"
	     (entlast)
	     ""
	     p2
	     (polar p2 (angle pc p2) (* 0.5 wid))
    )
    (command ".move"
	     (entlast)
	     ""
	     p2
	     (polar p2 (angle p2 pc) (* 0.5 wid))
    )
  )
  (if (> n 1)
    (command ".array"
	     (list (entlast) p1)
	     ""
	     "p"
	     pc
	     (1+ n)
	     ang3
	     "y"
    )
  )
  (redraw ent1 4)
)
;;判断一个点在左侧还是右侧
;;参数：sp ep pt 点
;;方向：sp 到 ep
;;返回值：左侧－１
;;				右侧１
;;				在同一条直线　０
;;方法：向量X乘向量				
(defun left_right ( sp ep pt / v1 v2 x1 x2 y1 y2  ver)
	(setq v1 (mapcar '- ep sp))
	(setq v2 (mapcar '- pt sp))
	(setq ver (- (* (car v1) (cadr v2)) (* (car v2) (cadr v1))))
	ver

)


