;;;pre-procession

  (#ppls "wwpublic")

(if (null $ptoe)
  (#ppls "pppp")
)
;;;end pre-procession

;;;标准横断面绘制程序2002-11-4 16:07
;;;任蔚青增加，用于和新道路平面程序配套使用，从而代替hdstddm函数
(defun $bzhdm ( / blb hbl vbl lay)
  (pub_save_var)
  (#ppas "drawroad")
  (setq ent (HY_SelSingleEnt "<回车> 自定义横断面 / 请选择定义标准横断面参照的中心线:" "ARC,LINE,*POLYLINE" "AXIS" nil))
  (if (/= ent nil)
    (setq blb (bzhdm (car ent) (cadr ent)))
    (setq blb (bzhdm))
  );;;if
  (if (/= blb nil)
    (progn
       (setq hbl (car blb)
             vbl (cadr blb)
       )
       (DL_MakeLayer "PP-DL-BZHD")
       ($hdm_ymg hbl vbl)
       
    );;;progn
  );;;if
  (pub_re_var)
);;;defun 
;;;;;;;;;;;;;;;;;;;;2002-11-4 16:07


;;;=======================布置预埋管,可单独使用=======================
(defun $hdm_ymg	(xc_h_bl  xc_v_bl  /	    w_flag   w_pt     w_jcj
		 w_ep0	  w_lrsb   w_yspb   w_pt1    w_dmx    w_lme
		 w_lrsb	  w_sca	   w_endb   w_xzpb   w_pt     w_d0
		 w_need	  w_xc	   w_prpb   w_ymr    w_yskk   w_pd
		 w_ang	  w_ymup   w_ymdp   w_lp     w_pos    w_next
		 w_outp	  w_inp	   w_lmp    w_npos   w_oldw   w_ymue
		 w_ymde	  w_flag1  w_old_os
		)
  (pub_save_var)
  (if (null $ptoe)
    (#ppls "pppp")
  )
  (setq	w_flag 1
	w_sca  (DL_GetDrawingFactor)
  )
  (while (= w_flag 1)
   
  ;;;;;  (setq w_old_os (getvar "osmode"))
    (sa_osmode)
    (setvar "osmode" 512)
    (setq w_pt (getpoint "\n回车退出 / 在检查井竖壁上点取预埋管终点:"))
    ;;;;;(setvar "osmode" w_old_os)
    (if	(null w_pt)
      (setq w_flag 0
	    w_jcj 0
      )
      (progn
	(setq w_jcj ($ptoe w_pt '((0 . "LINE") (8 . "PP-DL-BZHD"))))
	(if (null w_jcj)
	  (prompt "\n没选中检查井竖壁 , 请重选!")
	  (progn
	    (setq w_jcj	 (ssname w_jcj 0)
		  w_lrsb (HY_QQ10xx w_jcj "dwapp" 1070)
	    )
	    (if	(and (/= w_lrsb 101) (/= w_lrsb 102))
	      (progn (prompt "\n没选中检查井竖壁 , 请重选!")
		     (setq w_jcj 0)
	      )
	      (setq w_ep0 ($qtyd w_pt w_jcj))
	    )
	  )
	)
      )
    )
    (setq w_flag1 1
	  w_yspb '()
    )
    (while (and (= (type w_jcj) 'ENAME) (= w_flag1 1))
      (sa_osmode)
      (setvar "osmode" 1)
      (setq w_pt1
	     (getpoint
	       "\n回车结束选择 / 在路面线上点取雨水口位置(直排点取道牙底部侧排点取道牙顶部):"
	     )
      )
      (re_osmode)
      (if (null w_pt1)
	(setq w_flag1 0)
	(progn
	  (setq	w_dmx
		 ($ptoe w_pt1 '((0 . "*POLYLINE") (8 . "PP-DL-BZHD")))
	  )
	  (if (null w_dmx)
	    (prompt "\n所选点不在路面线上 , 请重选!")
	    (progn
	      (setq w_dmx (ssname w_dmx 0))
	      (if (/= (HY_QQ10xx w_dmx "dwapp" 1070) 100)
		(progn (prompt "\n所选点不在路面线上 , 请重选!")
		       (setq w_dmx 0)
		)
		(setq w_yspb (cons w_pt1 w_yspb)
		      w_lme  w_dmx
		)
	      )
	    )
	  )
	)
      )
    )
    (if	(and (= (type w_jcj) 'ENAME) (> (length w_yspb) 0))
      (progn
	(command ".view" "s" "w_old_view")
	(if (null xc_h_bl)
	  (progn
	    (initget 7)
	    (setq xc_h_bl (getint "输入横向比例:"))
	    (initget 7)
	    (setq xc_v_bl (getint "输入竖向比例:"))
	    (setq xc_h_bl (/ 1000.0 xc_h_bl w_sca)
		  xc_v_bl (/ 1000.0 xc_v_bl w_sca)
	    )
	  )
	)
	(setq w_endb (ptbxpx (bg-ypp w_lme))
	      w_xzpb '()
	)
;;;把点精确定位于路面线上
	(foreach w_pt w_yspb
	  (if
	    (< (pmdist w_pt (car w_endb)) (pmdist w_pt (cadr w_endb)))
	     (setq w_d0	  (pmdist w_pt (car w_endb))
		   w_need (car w_endb)
	     )
	     (setq w_d0	  (pmdist w_pt (cadr w_endb))
		   w_need (cadr w_endb)
	     )
	  )
	  (foreach w_pt1 w_endb
	    (if	(< (pmdist w_pt w_pt1) w_d0)
	      (setq w_d0   (pmdist w_pt w_pt1)
		    w_need w_pt1
	      )
	    )
	  )
	  (setq w_xzpb (cons w_need w_xzpb))
	)
	(if (> (length w_xzpb) 0)
	  (setq w_xzpb (dwglq w_xzpb))
	)
	(if (= w_lrsb 101)		;左井壁
	  (progn
	    (setq w_xc	 (car w_ep0)
		  w_prpb '()
	    )
	    (foreach w_pt w_xzpb
	      (if (< (car w_pt) w_xc)
		(setq w_prpb (cons w_pt w_prpb))
	      )
	    )
	    (if	(= (length w_prpb) 0)
	      (prompt "\n没选中合适的雨水口位置点!")
	      (progn
		(setq w_prpb (ptbxpx w_prpb)
		      w_ymr  1.0
		      w_yskk (* 0.2 xc_h_bl)
		      w_pd   0.005
		      w_ang  (atan w_pd)
		      w_ymup (polar w_ep0 (* 0.5 pi) (* 0.5 w_ymr))
		      w_ymdp (polar w_ep0 (* 1.5 pi) (* 0.5 w_ymr))
		      w_lp   (car w_prpb) ;最左端点
		      w_prpb (cdr w_prpb)
		      w_pos  (##getindex w_lp w_endb)
		      w_pt1  (nth (1+ w_pos) w_endb)
		)
		(HY_SV)
		(command ".break" (list w_jcj w_ymdp) w_ymup)
		(HY_RV)
;;;处理最端点
		(if (equal (car w_lp) (car w_pt1) 0.001) ;侧排
		  (progn
         (setq w_next (polar w_lp pi w_yskk)
			  w_npos ($loca_num (car w_next) w_endb)
             
			  w_outp (inters w_ymdp
					 (polar w_ymdp (- pi w_ang) 10.0)
					 w_next
					 (polar w_next (* 0.5 pi) 10.0)
					 nil
				 )
			  w_inp	 (inters w_ymup
					 (polar w_ymup (- pi w_ang) 10.0)
					 w_lp
					 (polar w_lp (* 0.5 pi) 10.0)
					 nil
				 )
			  w_lmp	 (inters (car w_npos)
					 (cadr w_npos)
					 w_next
					 (polar w_next (* 0.5 pi) 10.0)
					 nil
				 )
		    )
		    (HY_SV)
		    (command ".line" w_lmp w_outp "")
		    (command ".line" w_lp w_inp "")
		    (setvar "plinewid" (/ 0.25 w_sca))
		    (command ".pline" w_inp w_ymup "")
		    (setq w_ymue (entlast))
		    (HY_RV)
		  )
		  (progn		;直排
		    (setq w_next (polar w_lp 0 w_yskk)
			  w_npos ($loca_num (car w_next) w_endb)
			  w_outp (inters w_ymdp
					 (polar w_ymdp (- pi w_ang) 10.0)
					 w_lp
					 (polar w_lp (* 0.5 pi) 10.0)
					 nil
				 )
			  w_inp	 (inters w_ymup
					 (polar w_ymup (- pi w_ang) 10.0)
					 w_next
					 (polar w_next (* 0.5 pi) 10.0)
					 nil
				 )
			  w_lmp	 (inters (car w_npos)
					 (cadr w_npos)
					 w_next
					 (polar w_next (* 0.5 pi) 10.0)
					 nil
				 )
		    )
		    (HY_SV)
		    (command ".line" w_lmp w_inp "")
		    (command ".line" w_lp w_outp "")
		    (setvar "plinewid" (/ 0.25 w_sca))
		    (command ".pline" w_inp w_ymup "")
		    (setq w_ymue (entlast))
		    (HY_RV)
		  )
		)
		(setq w_pre1 w_outp
		      w_pre2 w_ymdp
		)
;;;处理中间点
		(foreach w_lp w_prpb
		  (setq	w_pos (##getindex w_lp w_endb)
			w_pt1 (nth (1+ w_pos) w_endb)
		  )
		  (if (equal (car w_lp) (car w_pt1) 0.001) ;侧排
		    (setq w_next (polar w_lp pi w_yskk))
		    (setq w_next (polar w_lp 0 w_yskk))
		  )
		  (setq	w_npos ($loca_num (car w_next) w_endb)
			w_outp (inters w_ymup
				       (polar w_ymup (- pi w_ang) 10.0)
				       w_next
				       (polar w_next (* 0.5 pi) 10.0)
				       nil
			       )
			w_inp  (inters w_ymup
				       (polar w_ymup (- pi w_ang) 10.0)
				       w_lp
				       (polar w_lp (* 0.5 pi) 10.0)
				       nil
			       )
			w_lmp  (inters (car w_npos)
				       (cadr w_npos)
				       w_next
				       (polar w_next (* 0.5 pi) 10.0)
				       nil
			       )
		  )
		  (HY_SV)
		  (zm2pt (polar w_outp (angle w_inp w_outp) 10.0)
			 (polar w_inp (angle w_outp w_inp) 10.0)
		  )
		  (command ".break" w_outp w_inp)
		  (command ".line" w_lmp w_outp "")
		  (command ".line" w_lp w_inp "")
		  (HY_RV)
		)
		(HY_SV)
		(command ".pline" w_pre1 w_pre2 "")
		(setq w_ymde (entlast))
		(HY_RV)
	      )
	    )
	  )
	  (progn			;右井壁
	    (setq w_xc	 (car w_ep0)
		  w_prpb '()
	    )
	    (foreach w_pt w_xzpb
	      (if (> (car w_pt) w_xc)
		(setq w_prpb (cons w_pt w_prpb))
	      )
	    )
	    (if	(= (length w_prpb) 0)
	      (prompt "\n没选中合适的雨水口位置点!")
	      (progn
		(setq w_prpb (ptbxpx w_prpb)
		      w_ymr  1.0
		      w_yskk (* 0.2 xc_h_bl)
		      w_pd   0.005
		      w_ang  (atan w_pd)
		      w_ymup (polar w_ep0 (* 0.5 pi) (* 0.5 w_ymr))
		      w_ymdp (polar w_ep0 (* 1.5 pi) (* 0.5 w_ymr))
		      w_lp   (last w_prpb) ;最右端点
		      w_prpb (reverse (cdr (reverse w_prpb)))
		      w_pos  (##getindex w_lp w_endb)
		      w_pt1  (nth (1- w_pos) w_endb)
		)
		(HY_SV)
		(command ".break" (list w_jcj w_ymdp) w_ymup)
		(HY_RV)
;;;处理最端点
		(if (equal (car w_lp) (car w_pt1) 0.001) ;侧排
		  (progn
		    (setq w_next (polar w_lp 0 w_yskk)
			  w_npos ($loca_num (car w_next) w_endb)
			  w_outp (inters w_ymdp
					 (polar w_ymdp w_ang 10.0)
					 w_next
					 (polar w_next (* 0.5 pi) 10.0)
					 nil
				 )
			  w_inp	 (inters w_ymup
					 (polar w_ymup w_ang 10.0)
					 w_lp
					 (polar w_lp (* 0.5 pi) 10.0)
					 nil
				 )
			  w_lmp	 (inters (car w_npos)
					 (cadr w_npos)
					 w_next
					 (polar w_next (* 0.5 pi) 10.0)
					 nil
				 )
		    )
		    (HY_SV)
		    (command ".line" w_lmp w_outp "")
		    (command ".line" w_lp w_inp "")
		    (setvar "plinewid" (/ 0.25 w_sca))
		    (command ".pline" w_inp w_ymup "")
		    (setq w_ymue (entlast))
		    (HY_RV)
		  )
		  (progn		;直排
		    (setq w_next (polar w_lp pi w_yskk)
			  w_npos ($loca_num (car w_next) w_endb)
			  w_outp (inters w_ymdp
					 (polar w_ymdp w_ang 10.0)
					 w_lp
					 (polar w_lp (* 0.5 pi) 10.0)
					 nil
				 )
			  w_inp	 (inters w_ymup
					 (polar w_ymup w_ang 10.0)
					 w_next
					 (polar w_next (* 0.5 pi) 10.0)
					 nil
				 )
			  w_lmp	 (inters (car w_npos)
					 (cadr w_npos)
					 w_next
					 (polar w_next (* 0.5 pi) 10.0)
					 nil
				 )
		    )
		    (HY_SV)
		    (command ".line" w_lmp w_inp "")
		    (command ".line" w_lp w_outp "")
		    (setvar "plinewid" (/ 0.25 w_sca))
		    (command ".pline" w_inp w_ymup "")
		    (setq w_ymue (entlast))
		    (HY_RV)
		  )
		)
		(setq w_pre1 w_outp
		      w_pre2 w_ymdp
		)
;;;处理中间点
		(foreach w_lp w_prpb
		  (setq	w_pos (##getindex w_lp w_endb)
			w_pt1 (nth (1- w_pos) w_endb)
		  )
		  (if (equal (car w_lp) (car w_pt1) 0.001) ;侧排
		    (setq w_next (polar w_lp 0 w_yskk))
		    (setq w_next (polar w_lp pi w_yskk))
		  )
		  (setq	w_npos ($loca_num (car w_next) w_endb)
			w_outp (inters w_ymup
				       (polar w_ymup w_ang 10.0)
				       w_next
				       (polar w_next (* 0.5 pi) 10.0)
				       nil
			       )
			w_inp  (inters w_ymup
				       (polar w_ymup w_ang 10.0)
				       w_lp
				       (polar w_lp (* 0.5 pi) 10.0)
				       nil
			       )
			w_lmp  (inters (car w_npos)
				       (cadr w_npos)
				       w_next
				       (polar w_next (* 0.5 pi) 10.0)
				       nil
			       )
		  )
		  (HY_SV)
		  (zm2pt (polar w_outp (angle w_inp w_outp) 10.0)
			 (polar w_inp (angle w_outp w_inp) 10.0)
		  )
		  (command ".break" w_outp w_inp)
		  (command ".line" w_lmp w_outp "")
		  (command ".line" w_lp w_inp "")
		  (HY_RV)
		)
		(HY_SV)
		(command ".pline" w_pre1 w_pre2 "")
		(setq w_ymde (entlast))
		(HY_RV)
	      )
	    )
	  )
	)
	(command "view" "r" "w_old_view")
	(command ".view" "d" "w_old_view")
      )
    )
  )
  (pub_re_var)
  (princ)
)
;;;
(defun $loca_num (xc_num xc_sortb / w_ii w_blen w_bii w_zone)
;;;判断某一实数是否在一有序表的范围内,有序表包含子表,决定于子表中的第一项
;;;若在返回他两边的子表否则返回空
	(setq	w_ii	 0
				xc_num (float xc_num)
				w_blen (length xc_sortb)
	)
	(if	(or	(< xc_num (caar xc_sortb))
					(> xc_num (car (last xc_sortb)))
			)
		(setq w_zone nil)
		(while (< w_ii w_blen)
			(setq w_bii (nth w_ii xc_sortb))
			(if	(= xc_num (car w_bii))
				(setq	w_ii	 w_blen
							w_zone (list w_bii w_bii)
				)
				(if	(> xc_num (car w_bii))
					(setq w_ii (1+ w_ii))
					(setq	w_zone (list (nth (1- w_ii) xc_sortb) w_bii)
								w_ii	 w_blen
					)
				)
			)
		)
	)
	w_zone
)
;;;--------------------------------------------
(princ)
