;;; 等高线 dgx(flag) flag == "zr"/"sj"
;;;------------------------------

;;;修改:         汪洪涛
;;;修改日期:     02/16/2001
;;;修改内容:     1.原来文件@@fdgx.lsp中的内容全部包含进来
;;;              2.所有菜单命令全部在该文件中定义
;;;              3.所有命令从主界面上的按钮激活
;;;              4.每一项功能单独定义一个函数
;;;              5.原来文件@ddbg.lsp中的内容全部包含进来
;;;              6.原来文件#zzrdbg.lsp中的内容全部包含进来
;;;              7.原来文件dxchkpbg.lsp中的内容全部包含进来
;;;              8.增加文件定义功能
;;;              9.增加快速转化功能

;;;修改：        张晓伟
;;;日期：        07/11/2002
;;;内容：        #zzrdbg函数  选择一个文字后，再让设计人员选择其代表的标高点的准确位置
;;;                           程序做成循环结构。提示转换一批文字后，还可以再接着转换另一批文字。
;;;                           转换时，询问是否把文字转换到其它层上。新层命名原则：原层名+"lsdtmp"

;;;定义全局变量
;;*** 缺省等高距 ***
(if (= dgx~dgj nil)
  (setq dgx~dgj 2.0)
)
;;*** 缺省标高 ***
(if (= dgx~bg nil)
  (setq dgx~bg 12.0)
)
;;;定义自然等高线命令
;;; 1.绘制
(defun c:zrdgx_hz ()
        (En_Reactor)
        (setq *error* global_err)
        (hy_set0)
  	(DL_MakeLayer "PP-DX-DGXZ")
 	(dgx_hz_zs "PP-DX-DGXZ" "自然标高" "zr")
 	(hy_set1)
 	(setq *error* nil)
 	(Un_Reactor)
)
;;; 2.逐根定义
(defun c:zrdgx_sdef () 
        (En_Reactor)
        (setq *error* global_err)
        (hy_set0)
	(DL_MakeLayer "PP-DX-DGXZ")
	(dgx_dy_x "PP-DX-DGXZ" "自然标高")
	(hy_set1)
	(setq *error* nil)
	(Un_Reactor)
)
;;; 3.成组定义
(defun c:zrdgx_mdef () 
        (En_Reactor)
        (setq *error* global_err)
        (hy_set0)
	(DL_MakeLayer "PP-DX-DGXZ")
	(dgx_dy_r "PP-DX-DGXZ")
	(hy_set1)
	(setq *error* nil)
	(Un_Reactor)
)
;;; 4. 搜索定义
(defun c:zrdgx_fdef () 
        (En_Reactor)
        (setq *error* global_err)
        (hy_set0)
	(DL_MakeLayer "PP-DX-DGXZ")
	(dgx_dy_s "PP-DX-DGXZ" "自然标高")
	(hy_set1)
	(setq *error* nil)
	(Un_Reactor)
)
;;; 5.快速转化
(defun c:zrdgx_trans () 
    (En_Reactor)
    (setq *error* global_err)
    (hy_set0)
	(DL_MakeLayer "PP-DX-DGXZ")
	;;(dgx_dy_k "PP-DX-DGXZ")
	(#ppas "earthwork")
	(undo_m)
	(TF_QuickConvert)
	(#ppuas "earthwork")
	(hy_set1)
	(setq *error* nil)
	(Un_Reactor)
)

;;;自然等高线标高检查
(defun c:zrdgx_chk () 
(En_Reactor) 
(setq *error* global_err)
(hy_set0)
(#ppas "earthwork")
(undo_m)
(CheckContourElev 0)
(#ppuas "earthwork")
(hy_set1)
(setq *error* nil)
(Un_Reactor)
)

;;; 8.离散
(defun c:zrdgx_sep () 
    (En_Reactor)
    (setq *error* global_err)
    (hy_set0)
	(DL_MakeLayer "PP-DX-PT")
	;;(dgx_ls_zs "zr" "自然标高")
	(#ppas "earthwork")
	(undo_m)
	(TF_DisperseContour 0)
	(#ppuas "earthwork")
	(hy_set1)
	(setq *error* nil)
	(Un_Reactor)
)


;;;;;任蔚青增加2003-3-7 14:33　　begin

;;;;由自然标高离散点构造三角网
;;(defun c:szdl_sjw ()
;;  (#ppas "HYDGX")
;;  (Make_SJW)
;;  (#ppuas "HYDGX")
;;)
(defun c:sz_zr_sjw()
   (En_Reactor)
   (hy_set0)
   (#ppas "earthwork")
   (undo_m)
   (MAKE_Tin "zr")
   (#ppuas "earthwork")
   (hy_set1)
   (Un_Reactor)
)


;;;;由设计标高离散点构造三角网
(defun c:sz_sj_sjw()
   (En_Reactor)
   (hy_set0)
   (#ppas "earthwork")
   (undo_m)
   (MAKE_Tin "sj")
   (#ppuas "earthwork")
   (hy_set1)
   (Un_Reactor)
)

;;由三角网构造自然等高线
;;(defun c:sz_zr_contour()
;;  (En_Reactor)
;;  (hy_set0)
;;  (DL_MakeLayer "PP-DX-DGXZ")
;; (#ppas "HYDGX")
;;  (undo_m)
;;  (Make_DGX "zr")
;;  (#ppuas "HYDGX")
;;  (hy_set1)
;;  (Un_Reactor)
;;)


;;;;由三角网构造设计等高线
;;(defun c:sz_sj_contour()
;; (En_Reactor)
;;  (hy_set0)
;;  (DL_MakeLayer "PP-DX-DGXS")
;;  (#ppas "HYDGX")
;;  (undo_m)
;;  (Make_DGX "sj")
;;  (#ppuas "HYDGX")
;;  (hy_set1)
;;  (Un_Reactor)
;;)

;;;;因新的等高线算法生成时最后一根等高线不对，因此没有替换
(defun c:sz_zr_contour()
   (En_Reactor)
   (#ppas "earthwork")
   (undo_m)
   (MAKE_Contour "zr")
   (#ppuas "earthwork")
   (Un_Reactor)
)
(defun c:sz_sj_contour()
   (En_Reactor)
   (#ppas "earthwork")
   (undo_m)
   (MAKE_Contour "sj")
   (#ppuas "earthwork")
   (Un_Reactor)
)



(defun c:t_hdgx	()
  (En_Reactor)
  (setq *error* global_err)
  (hy_set0)
  (DL_MakeLayer "PP-DX-DGXZ")
  (#ppls "&sdhdgx")
  (&t_hdgx)
  (hy_set1)
  (setq *error* nil)
  (Un_Reactor)
)
;;;由三点标高绘等高线
(defun c:f_hdgx	()
  (En_Reactor)
  (setq *error* global_err)
  (hy_set0)
  (DL_MakeLayer "PP-DX-DGXZ")
  (#ppls "&sdhdgx")
  (&f_hdgx)
  (hy_set1)
  (setq *error* nil)
  (Un_Reactor)
)
;;;由四点标高绘等高线  

;;;;;任蔚青增加2003-3-7 14:33　　end
;;;定义交叉口等高线命令
;;; 1.绘制
(defun c:jckdgx_hz ()
  (En_Reactor)
  (setq *error* global_err)
  (hy_set0)
  (DL_MakeLayer "PP-DL-JCKDGX")
  (dgx_hz_zs "PP-DL-JCKDGX" "等高线标高" "jck")
  (hy_set1)
  (setq *error* nil)
  (Un_Reactor)
)
;;; 2.逐根定义
(defun c:jckdgx_sdef ()
  (En_Reactor)
  (setq *error* global_err)
  (hy_set0)
  (DL_MakeLayer "PP-DL-JCKDGX")
  (dgx_dy_x "PP-DL-JCKDGX" "等高线标高")
  (hy_set1)
  (setq *error* nil)
  (Un_Reactor)
)
;;; 3.成组定义
(defun c:jckdgx_mdef () 
  (En_Reactor)
  (setq *error* global_err)
  (hy_set0)
  (DL_MakeLayer "PP-DL-JCKDGX")
  (dgx_dy_r "PP-DL-JCKDGX")
  (hy_set1)
  (setq *error* nil)
  (Un_Reactor)
)
;;; 4. 搜索定义
(defun c:jckdgx_fdef ()
  (En_Reactor)
  (setq *error* global_err)
  (hy_set0)
  (DL_MakeLayer "PP-DL-JCKDGX")
  (dgx_dy_s "PP-DL-JCKDGX" "等高线标高")
  (hy_set1)
  (setq *error* nil)
  (Un_Reactor)
)
;;; 5.快速转化
(defun c:jckdgx_trans () 
  (En_Reactor)
  (setq *error* global_err)
  (hy_set0)
  (DL_MakeLayer "PP-DL-JCKDGX")
  (dgx_dy_k "PP-DL-JCKDGX")
  (hy_set1)
  (setq *error* nil)
  (Un_Reactor)
)
;;; 6.修改
(defun c:jckdgx_modi () 
 (En_Reactor)
 (setq *error* global_err)
 (hy_set0)
 (jckdgx_xg_zs)
 (hy_set1)
 (setq *error* nil)
 (Un_Reactor)
)
;;; 7.标注
(defun c:jckdgx_bz () 
(En_Reactor)
(setq *error* global_err)
(hy_set0)
(jckdgx_bz_zs)
(hy_set1)
(setq *error* nil)
(Un_Reactor)
)


;;;定义设计等高线命令
;;; 1.绘制
(defun c:sjdgx_hz ()
  (En_Reactor)
  (setq *error* global_err)
  (hy_set0)
   (DL_MakeLayer "PP-DX-DGXS")
  (dgx_hz_zs "PP-DX-DGXS" "设计标高" "sj")
  (hy_set1)
  (setq *error* nil)
  (Un_Reactor)
)
;;; 2.交互定义
(defun c:sjdgx_sdef () 
        (En_Reactor)
        (setq *error* global_err)
        (hy_set0)
	(DL_MakeLayer "PP-DX-DGXS")
	(dgx_dy_x "PP-DX-DGXS" "设计标高")
	(hy_set1)
	(setq *error* nil)
	(Un_Reactor)
)
;;; 3.成组定义
(defun c:sjdgx_mdef () 
        (En_Reactor)
        (setq *error* global_err)
        (hy_set0)
	(DL_MakeLayer "PP-DX-DGXS")
	(dgx_dy_r "PP-DX-DGXS")
	(hy_set1)
	(setq *error* nil)
	(Un_Reactor)
)
;;; 4. 搜索定义
(defun c:sjdgx_fdef () 
        (En_Reactor)
        (setq *error* global_err)
        (hy_set0)
	(DL_MakeLayer "PP-DX-DGXS")
	(dgx_dy_s "PP-DX-DGXS" "设计标高")
	(hy_set1)
	(setq *error* nil)
	(Un_Reactor)
)
;;; 5.快速转化
(defun c:sjdgx_trans () 
        (En_Reactor)
        (setq *error* global_err)
        (hy_set0)
	(DL_MakeLayer "PP-DX-DGXS")
	(dgx_dy_k "PP-DX-DGXS")
	(hy_set1)
	(setq *error* nil)
	(Un_Reactor)
)
;;;设计等高线标高检查
(defun c:sjdgx_chk () 
(En_Reactor) 
(setq *error* global_err)
(hy_set0)
(#ppas "earthwork")
(undo_m)
(CheckContourElev 1)
(#ppuas "earthwork")
(hy_set1)
(setq *error* nil)
(Un_Reactor)
)

;;; 6.修改自然等高线
(defun c:zrdgx_modi ()
(En_Reactor)
(setq *error* global_err)
(hy_set0)
(dgx_xg_zs "zr")
(hy_set1)
(setq *error* nil)
(Un_Reactor)
)
;;; 6.修改设计等高线
(defun c:sjdgx_modi ()
(En_Reactor)
(setq *error* global_err)
(hy_set0)
(dgx_xg_zs "sj")
(hy_set1)
(setq *error* nil)
(Un_Reactor)
)
;;; 7.删除自然等高线
(defun c:zrdgx_del () 
(En_Reactor)
(setq *error* global_err)
(hy_set0)
(dgx_del_zs "zr")
(hy_set1)
(setq *error* nil)
(Un_Reactor)
)
;;; 7.删除设计等高线
(defun c:sjdgx_del () 
(En_Reactor)
(setq *error* global_err)
(hy_set0)
(dgx_del_zs "sj")
(hy_set1)
(setq *error* nil)
(Un_Reactor)
)
;;; 8.离散
(defun c:sjdgx_sep () 
        (En_Reactor)
        (setq *error* global_err)
        (hy_set0)
	(DL_MakeLayer "PP-SJ-PT")
	(dgx_ls_zs "sj" "设计标高")
	(hy_set1)
	(setq *error* nil)
	(Un_Reactor)
)
;;; 9.标注自然等高线
(defun c:zrdgx_bz () 
(En_Reactor)
(setq *error* global_err)
(hy_set0)
(dgx_bz_zs "ZR")
(hy_set1)
(setq *error* nil)
(Un_Reactor)
)

;;; 9.标注设计等高线
(defun c:sjdgx_bz () 
(En_Reactor)
(setq *error* global_err)
(hy_set0)
(dgx_bz_zs "SJ")
(hy_set1)
(setq *error* nil)
(Un_Reactor)
)
;;; 1. 绘等高线
(defun dgx_hz_zs (lay  cc   xc_flag   /	   dgj	fftt ft	  bg00 p01
		  p02  p03  p04	 ee   ps   pe	ss   ii	  e0   e0b
		  hh   ww
		 )
  (szload pub_save_var "wwpublic")
  (pub_save_var)
  (setq m_skold (getvar "skpoly"))
  (setvar "skpoly" 1)
  ;;*** text high
  (setq hh (/ (Dl_GetTextHeight) (DL_GetDrawingFactor)))
  ;;*** 小数位数 ***
  (setq ww (DL_GetDimPrec))
  (setq	dwlay lay;;层
	dwcc cc;;提示文本
  )
  (if (= dgx~dgj nil)
    (if	(= lay "PP-DL-JCKDGX")
      (setq dgx~dgj 0.1)
      (setq dgx~dgj 1.0)
    )
  )
  (setvar "clayer" lay)
  (initget 6)
  (setq dgj (getreal (strcat "\n等高距<" (rtos dgx~dgj 2 3) ">:")))
  (if dgj
    (setq dgx~dgj dgj)
    (setq dgj dgx~dgj)
  )
  (setq fftt t)
  (while fftt
    (initget "E")
    (setq
      bg00 (getreal
	     (strcat "\n 退出 E / " cc "<" (rtos dgx~bg 2 3) ">:")
	   )
    )
    (if	(= bg00 "E")
      (setq fftt nil)
      (progn
	(if (= bg00 nil)
	  (setq bg00 dgx~bg)
	)
	(setq dgx~bg (+ bg00 dgx~dgj))
	;;(setvar "elevation" bg00);;(command ".change" s1 "" "p" "la" newlay "")

	(setq ft t)
	(initget 1 "S")
	(setq p01 (getpoint "\n随手画S /<第一点>:"))
	(if (= p01 "S")
	  (progn
	    (setvar "skpoly" 1)
	    (setvar "cmdecho" 1)
	    (setq e0 (ent_last))
	    (command "sketch" "" pause)
	    ;;(while (/= (getvar "cmdnames") "") (command "pause"))
	    (setvar "cmdecho" 0)
	    (setq ss (get_last e0))
	    (if	ss
	      (progn
	      	 ;;lxf [2003/7/14] Modify---start
		  (command ".change" ss "" "p" "E" bg00 "")
		 ;;lxf [2003/7/14] Modify---end
		(setq ii 0)
		(repeat	(sslength ss)
		  (setq	e0  (ssname ss ii)
			e0b (entget e0)
		  )

		  (if (= (cdr (assoc 0 e0b)) "*POLYLINE")
		    (progn
		      (if (or (= xc_flag "zr") (= xc_flag "jck"))
			(command "pedit" e0 "s" "x")
		      )			;*** 自然等高线拟合 ***
					;(command "explode" e0)
		    )
		  )
		  (setq ii (1+ ii))
		)
	      )
	    )
	  )
	  (progn
	    (setq ps p01)
	    (command "pline" p01 "w" 0.0 0.0)
	    (initget 1)
	    (setq p02 (getpoint p01 "\n第二点:"))
	    
	    (if p02
	       (progn
	          (setq ft t)
	          (command p02)
	        )
	       (progn
	          (setq ft nil)
	          (command "")
	       )
	    )
	    (while ft
	      (initget "C")
	      (setq
		p03 (getpoint p02 "\n回车返回 / 闭合 C / <下一点>:")
	      )
	      (cond
		((= p03 "C")
		 (command "c")
		 (setq ee (entlast))
		 (setq ft nil)
		)
		((= p03 nil)
		 (command "")
		 (setq ee (entlast))
		 (setq ft nil)
		)
		(t
		 (command p03)
		 (setq p02 p03)
		)
	      )
	    )
	 ;;lxf [2003/7/14] Modify---start
	  (command ".change" ee "" "p" "E" bg00 "")
	 ;;lxf [2003/7/14] Modify---end
	    (setq pe (getvar "lastpoint"))
	    (if	(= xc_flag "zr")
	      (command "pedit" ee "f" "x")
	    )				;*** 自然等高线拟合 ***
					;(command "explode" ee)

	    (command "text" "j" "mc" ps hh 0.0 (rtos bg00 2 ww))
	    (command "text" "j" "mc" pe hh 0.0 (rtos bg00 2 ww))
	  )
	)
      )
    )
  )
  (setvar "skpoly" m_skold)
  (setvar "clayer" "PP-COM")
  ;;(setvar "elevation" 0.0)
  (pub_re_var)
  (princ)
)
;;------------------------------
;; 1996.09.24 tue
;; 定义等高线 dydgx(lay cc)
;;------------------------------
;;; 2.交互定义
(defun dgx_dy_x	(lay cc / m_skold m_flag m_ss m_ii m_bg0 m_e m_lx)
  (szload pub_save_var "wwpublic")
  (pub_save_var)
  (setq m_skold (getvar "skpoly"))
  (setvar "skpoly" 1)
  (DL_MakeLayer lay)
  (setq m_flag t)
  (while m_flag
    (prompt "\n 回车退出 / 选择同一测量高度的等高线:")
    ;;增加圆弧的处理
    (setq m_ss (ssget (list (cons 0 "LINE,ARC,*POLYLINE,SPLINE") (cons -4 "<not") (cons 8 lay) (cons -4 "not>"))))
    (if	(null m_ss)
      (setq m_flag nil)
      (progn
	(setq m_ii 0)
	(initget 1)
	(setq m_bg0 (getreal (strcat "\n" cc "(m):")))
	(setq m_ii 0)
	(repeat	(sslength m_ss)
	  (setq	m_e  (ssname m_ss m_ii)
		m_lx (cdr (assoc 0 (entget m_e)))
	  )
	  (DL_SetZElev m_e m_bg0 lay) 	
	  ;;lhr 修改增加圆弧的处理
	  (if (or (= m_lx "LINE") (= m_lx "ARC"))
	    (command "pedit" m_e "Y" "X")
	  )
	  ;;lhr 修改结束
	  (setq m_ii (1+ m_ii))
	)
      )
    )
  )
  (setvar "skpoly" m_skold)
  (setvar "clayer" "PP-COM")
  (pub_re_var)
  (princ)
)

;;; 3.成组定义
(defun dgx_dy_r	(lay   /     p1	   p2	 dgj   e     ss	   ssl	 en
		 jd    jdb   p1_jd p1_jdb      p1bg  entb  p3	 p4
		 zjz_bg	     EntData
		)
  (szload pub_save_var "wwpublic")
  (pub_save_var)
  (setq m_skold (getvar "skpoly"))
  (setvar "skpoly" 1)
  (DL_MakeLayer lay)
  (setq p1 (getpoint "\n 回车退出 / 请点取篱笆选择起点:"))
  (if p1
    (setq p2 (getpoint p1 "\n 回车退出 / 请点取篱笆选择终点:"))
  )
  (if (and p1 p2)
    (progn
      (HY_SV)
      (grdraw p1 p2 -1 -1)
      (setq p1bg
	     (getreal
	       "\n请输入首根(距篱笆起点最近)与篱笆相交的等高线标高<12.0>:"
	     )
      )
      (if (null p1bg)
	(setq p1bg 12)
      )
      (if (= lay "PP-DL-JCKDGX")
	(setq dgj 0.1)
	(setq dgj 1.0)
      )
      (initget 6)
      (setq
	zjz_bg (getreal (strcat "\n 输入等高距<" (rtos dgj 2 3) ">:"))
      )
      (if zjz_bg
	(setq dgj zjz_bg)
      )
      (&view_ptb (list p1 p2))
      (setq
	ss (ssget "f" (list p1 p2) '((0 . "*POLYLINE,LINE,ARC,SPLINE")));;增加对圆弧的处理
      )
      (if ss
	(progn
	  (setq ssl (sslength ss))
	  (setq index 0)
	  (repeat ssl
	    (setq en (ssnamex ss index))
	    (if	en
	      (progn
;;;modi 1998.08.28
		(setq EntData (car en)
		      en      (cadr EntData)
		      jd      (cadar (cdddr EntData))
		)
		;;lhr 修改增加圆弧处理
		(if (= (type en) 'ENAME)
		   (progn
		     (setq enType (cdr (assoc 0 (entget en))))
		     (if (or (= enType "LINE") (= enType "ARC") )
		         (progn 
		            (command ".pedit" en "" "")
		            (setq en (entlast))
		         )
		     )
		   )
		)
		;;修改结束
		;;(if (#is_line en)
		;;  (progn
		;;    (command ".pedit" en "" "")
		  ;;  (setq en (entlast))
		 ;; )
		;;)
;;;-----------
		(if jd
		  (progn
		    (setq p1_jd (pmdist p1 jd))
		    (setq jdjl (list jd p1_jd))
		    (setq p1_jdb (cons jdjl p1_jdb))
		  )
		)
	      )
	    )
	    (setq index (1+ index))
	  )
	  (setq p1_jdb (lispx p1_jdb))
	  (setq p1_jdbl (length p1_jdb))
	  (setq index 0)
	  (repeat p1_jdbl
	    (setq p1n (car (nth index p1_jdb)))
	    (setq glb '((0 . "*polyline,arc,line,spline")))
	    (setq en (mentselp p1n glb nil))
	    (if	en
		(DL_SetZElev en p1bg lay)
	    )
	    (setq p1bg (+ p1bg dgj))
	    (setq index (1+ index))
	  )
	)
      )
      (grdraw p1 p2 -1 -1)
    )
  )
  (setvar "skpoly" m_skold)
  (setvar "clayer" "PP-COM")
  (pub_re_var)
  (princ)
)

;;; 4. 搜索定义
(defun dgx_dy_s	(lay cc / m_ss m_skold m_flag m_ii m_bg0 m_e m_lx)
  (szload pub_save_var "wwpublic")
  (pub_save_var)
  (setq m_skold (getvar "skpoly"))
  (setvar "skpoly" 1)
  (DL_MakeLayer lay)
  (setq m_flag t)
  (while m_flag
    (setq m_ss (ssdgx))
    (if	(null m_ss)
      (setq m_flag nil)
      (progn
	(HY_SSRedraw m_ss 3)
	(setq m_ii 0)
	(initget 1)
	(setq m_bg0 (getreal (strcat "\n" cc "(m):")))
	(setq m_ii 0)
	(repeat	(sslength m_ss)
	  (setq	m_e  (ssname m_ss m_ii)
		m_lx (cdr (assoc 0 (entget m_e)))
	  )
	  (DL_SetZElev m_e m_bg0 lay)	  
	  (if (or (= m_lx "ARC") (= m_lx "LINE"))
	    (command "pedit" m_e "Y" "X")
	  )
	  (setq m_ii (1+ m_ii))
	)
	(HY_SSRedraw m_ss 4)
      )
    )
  )
  (setvar "skpoly" m_skold)
  (setvar "clayer" "PP-COM")
  (pub_re_var)
  (princ)
)

;;; 5.快速转化
;;;2002-8-2 12:44任蔚青修改函数定义，拷贝土方计算中的函数定义
(defun dgx_dy_k	(lay / ft e lays ss ii eb)
  (szload pub_save_var "wwpublic")
  (pub_save_var)
  (setq m_skold (getvar "skpoly"))
  (setvar "skpoly" 1)
  (setq ft t)
  (while ft
    ;;(setq e (HY_SelSingleEnt "\n选择样线:" "LINE,POLYLINE,LWPOLYLINE" nil nil))
    (setq e (HY_SelSingleEnt
	      "\n选择样线:"
	      "LINE,SPLINE,POLYLINE,LWPOLYLINE,ARC"
	      nil
	      nil
	    )
    )
    (cond
      ((= e nil) (setq ft nil))
      ((= e "RETURN")
       (prompt "\n请选择LINE,SPLINE,POLYLINE,LWPOLYLINE,ARC.")
      )
      (t
       (setq e	  (car e)
	     lays (strcase (cdr (assoc 8 (entget e))))
       )
       (prompt
	 (strcat "\n选择"
		 lays
		 "层的LINE,SPLINE,POLYLINE,LWPOLYLINE,ARC:"
	 )
       )
       (setq
	 ss (ssget
	      (list '(0 . "LINE,SPLINE,POLYLINE,LWPOLYLINE,ARC")
		    (cons 8 lays)
	      )
	    )
       )
       (if ss
	 (progn
	   (HY_SSRedraw ss 3)
	   (prompt "\n请稍候....")
	   (command "change" ss "" "p" "t" 0.0 "la" lay "")
	   (setq ii 0)
	   (repeat (sslength ss)
	     (setq e  (ssname ss ii)
		   eb (entget e)
	     )
	     (if (and (= (cdr (assoc 0 eb)) "LINE")
	              (equal (nth 2 (cdr(assoc 10 eb))) (nth 2 (cdr(assoc 11 eb))) 0.001)
	         )
	         (command "pedit" e "Y" "X")
	     )
	     (if (= (cdr (assoc 0 eb)) "ARC")
	       (command "pedit" e "Y" "X")
	     )
	     (HY_Waiting)
	     (princ)
;;;10:03 99-2-2add (princ)
	     (setq ii (1+ ii))
	   )
	   (HY_SSRedraw ss 4)
	   (princ "\010")
	 )
       )
      )
    )
  )
  (setvar "skpoly" m_skold)
  (setvar "clayer" "PP-COM")
  (pub_re_var)
  (princ)
)

(defun dgx_xg_zs 
       (flag / ft e eb lx lay bg0 bgnew ss ssss sst ii lay laypt app msg)
  (#ppls "@T_TFWG")
  (szload pub_save_var "wwpublic")
  (pub_save_var)
  (setq m_skold (getvar "skpoly"))
  (setvar "skpoly" 1)
  (HY_SV)
  (if (=  (strcase flag)  "ZR")
      (setq laydgx "PP-DX-DGXZ"
            msg "自然等高线"
      )
      (setq laydgx "PP-DX-DGXS"
            msg    "设计等高线"
      )
  )
  
  (setq ww (DL_GetDimPrec))		;*** 小数位数 ***
  (setq ft t)
  (while ft
    (setq e (HY_SelSingleEnt
	      (strcat "\n<回车返回> / 点取" msg ":")
	      "*POLYLINE,SPLINE"
	      laydgx
	      nil
	    )
    )
    (cond
      ((= e nil) (setq ft nil))
      ((= e "RETURN") (prompt (strcat "\n请选择" msg)))
      (t
       (setq e	 (car e)
	     eb	 (entget e)
	     lay (strcase (cdr (assoc 8 eb)))
       )
       (if (= lay "PP-DX-DGXZ")
	       (setq app "ZRBG"
		         laypt  "PP-DX-PT"
		   )
	       (setq app "SJBG"
		         laypt  "PP-SJ-PT"
		   )
       )
       (if (= (cdr (assoc 0 eb)) "LWPOLYLINE")
;;;modi 1998.06.06
	 (setq bg0 (cdr (assoc 38 eb)))
	 (setq bg0 (caddr (cdr (assoc 10 eb))))
       )

       (setq bgnew (getreal (strcat "\n新高度<" (rtos bg0 2 ww) ">:")))
       (if (= bgnew nil)
	 (setq bgnew bg0)
       )
	   (DL_SetZElev e bgnew laypt)	  
       (setq ss	(ssget "x"
		       (list (cons -4 "<or")

			     (cons -4 "<and")
			     (cons 0 "POLYLINE")
			     (cons 8 lay)
			     (cons -4 "*,*,=")
			     (cons 10 (list 0.0 0.0 bg0))
			     (cons -4 "and>")

			     (cons -4 "<and")
			     (cons 0 "LWPOLYLINE")
			     (cons 8 lay)
			     (cons -4 "=")
			     (cons 38 bg0)
			     (cons -4 "and>")

			     (cons -4 "<and")
			     (cons 0 "POINT")
			     (cons 8 laypt)
			     (list -3 (list app))
			     (cons -4 "*,*,=")
			     (cons 10 (list 0.0 0.0 bg0))
			     (cons -4 "and>")

			     (cons -4 "<and")
			     (cons 0 "TEXT")
			     (cons 8 lay)
			     (cons -4 "and>")

			     (cons -4 "or>")
		       )
		)
       )
       (if ss
	 (progn
	   (setq ssss (ssadd)
		 sst  (ssadd)
	   )
	   (setq ii 0)
	   (repeat (sslength ss)
	     (setq e  (ssname ss ii)
		   eb (entget e)
		   lx (cdr (assoc 0 eb))
	     )
	     ;;----- TEXT 不过虑 --------------------
	     (if (= lx "TEXT")
	       (progn
		 (setq ssss (ssadd e ssss))
		 (if (< (abs (- (atof (cdr (assoc 1 eb))) bg0)) 1.0e-3)
		   (setq sst (ssadd e sst))
		 )
	       )
	     )
	     (setq ii (1+ ii))
	   )
	   (setq ss (sscl ss ssss))	;***** (sscl ..) ss = ss - ssss
	   (if (> (sslength ss) 0)
	     (progn
	       (command "change" ss "" "p" "e" bgnew "")
	       (setq ii 0)
	       (repeat (sslength ss)
		 (setq e  (ssname ss ii)
		       eb (entget e)
		       ii (1+ ii)
		 )
		 (if (= (cdr (assoc 0 eb)) "POINT")
		   (HY_KZSJXZ e app 1040 bgnew)
		 )
	       )
	     )
	   )
	   (if (> (sslength sst) 0)
	     (progn
	       (setq ii 0)
	       (repeat (sslength sst)
		 (setq e  (ssname sst ii)
		       eb (entget e)
		       eb (subst (cons 1 (rtos bgnew 2 3)) (assoc 1 eb) eb)
		 )
		 (entmod eb)
		 (setq ii (1+ ii))
	       )
	     )
	   )
	 )
       )
      )
    )
  )
  (setvar "skpoly" m_skold)
  (HY_RV)
  (pub_re_var)
  (setvar "clayer" "PP-COM")
  (princ)
)
;;; 6.修改
(defun jckdgx_xg_zs
		    (/	    ft	   e	  eb	 lx	lay    bg0
		     bgnew  ss	   ssss	  sst	 ii	lay    laypt
		     app    num_undo	  pt_10
		    )
  (#ppls "@T_TFWG")
  (szload pub_save_var "wwpublic")
  (pub_save_var)
  (setq m_skold (getvar "skpoly"))
  (setvar "skpoly" 1)
  (HY_SV)
  (setq laydgx "PP-DL-JCKDGX")
  (setq ww (DL_GetDimPrec))		;*** 小数位数 ***
  (setq	ft t
	num_undo 0
  )
  (while ft
    (setq e (gpsseld (list (cons 8 laydgx)
			   '(-4 . "<or")
			   '(0 . "LWPOLYLINE")
			   '(0 . "POLYLINE")
			   '(0 . "SPLINE")
			   '(-4 . "or>")
		     )
		     "\n回车返回 /回退U / 点取交叉口等高线:"
		     "U"
	    )
    )
    (cond
      ((= e nil) (setq ft nil))
      ((= e "U")
       (if (= num_undo 0)
	 (prompt "\n 已经回退到最后!")
	 (progn
	   (setq num_undo (- num_undo 1))
	   (undo_b)
	 )
       )
      )
      (t
       (setq e	 (car e)
	     eb	 (entget e)
	     lay (strcase (cdr (assoc 8 eb)))
       )
       (if (or (= (cdr (assoc 0 eb)) "LWPOLYLINE")
	       (= (cdr (assoc 0 eb)) "SPLINE")
	   )
;;;modi 1998.06.06
	 (setq bg0 (cdr (assoc 38 eb)))
	 (setq pt_10 (cdr (assoc 10 eb))
	       bg0   (caddr pt_10)
	 )
       )

       (setq bgnew (getreal (strcat "\n新高度<" (rtos bg0 2 ww) ">:")))
       (if (= bgnew nil)
	 (setq bgnew bg0)
       )
       (undo_m)
       (setq num_undo (+ num_undo 1))
       (if (or (= (cdr (assoc 0 eb)) "LWPOLYLINE")
	       (= (cdr (assoc 0 eb)) "SPLINE")
	   )
	 (HY_KZSJXZ e nil 38 bgnew)
	 (HY_KZSJXZ e nil 10 (list (car pt_10) (cadr pt_10) bgnew))
       )
      )
    )
  )
  (setvar "skpoly" m_skold)
  (HY_RV)
  (pub_re_var)
  (setvar "clayer" "PP-COM")
  (princ)
)
;;; 7.删除
(defun dgx_del_zs ( flag /  ss bg0 ssss pt e	eb ii lx ft lay	laypt app msg)
  (szload pub_save_var "wwpublic")
  (pub_save_var)
  (setq m_skold (getvar "skpoly"))
  (setvar "skpoly" 1)

  (if (= (strcase flag) "ZR")
      (setq lay  "PP-DX-DGXZ"
            app "ZRBG"
            msg "自然等高线"
			laypt "PP-DX-PT"
      )
      (setq lay  "PP-DX-DGXS"
            app  "SJBG"
            msg "设计等高线"
			laypt "PP-SJ-PT"
      )
  )

  (setq ft t)
  (while ft
    (setq e (HY_SelSingleEnt
	      (strcat "\n回车返回 / 全部清除 A / 选要删除的" msg ":")
	      "*POLYLINE,SPLINE"
	      lay
	      nil
	      "A"
	     )
    )
    (cond
      ((= e nil) (setq ft nil))
      ((= e "A")
       (setq ft nil)
       (setq ss	(ssget "x"
		       (list '(0 . "*POLYLINE,TEXT,POINT,SPLINE")
			     (cons 8 (strcat lay "," laypt))
		       )
		)
       )
       (if ss
	 (command "erase" ss "")
       )
       (command "redraw")
      )
      ((= e "RETURN") (beep) (prompt (strcat "\n请选择" msg)))
      (t
       (setq e	 (car e)
	     eb	 (entget e)
	     lx	 (cdr (assoc 0 eb))
	     lay (strcase (cdr (assoc 8 eb)))
       )
       (if (= lx "LWPOLYLINE")
;;;modi 1998.06.06
	 (setq bg0 (cdr (assoc 38 eb)))
	 (setq bg0 (caddr (cdr (assoc 10 eb))))
       )

       (setq ss	(ssget "x"
		       (list (cons -4 "<or")

			     (cons -4 "<and")
			     (cons 0 "POLYLINE")
			     (cons 8 lay)
			     (cons -4 "*,*,=")
			     (cons 10 (list 0.0 0.0 bg0))
			     (cons -4 "and>")

			     (cons -4 "<and")
			     (cons 0 "LWPOLYLINE")
			     (cons 8 lay)
			     (cons -4 "=")
			     (cons 38 bg0)
			     (cons -4 "and>")

			     (cons -4 "<and")
			     (cons 0 "POINT")
			     (cons 8 laypt)
			     (list -3 (list app))
			     (cons -4 "*,*,=")
			     (cons 10 (list 0.0 0.0 bg0))
			     (cons -4 "and>")

			     (cons -4 "<and")
			     (cons 0 "TEXT")
			     (cons 8 lay)
			     (cons -4 "and>")

			     (cons -4 "or>")
		       )
		)
       )
       (if ss
	 (progn
	   (setq ssss (ssadd))
	   (setq ii 0)
	   (repeat (sslength ss)
	     (setq e  (ssname ss ii)
		   eb (entget e)
		   lx (cdr (assoc 0 eb))
	     )
					;----- TEXT 不过虑 --------------------
	     (if (= lx "TEXT")
	       (if (> (abs (- (atof (cdr (assoc 1 eb))) bg0)) 1.0e-3)
		 (setq ssss (ssadd e ssss))
	       )
	     )
	     (setq ii (1+ ii))
	   )
	   (szload sscl "@T_TFWG")
	   (setq ss (sscl ss ssss))	;***** (sscl ..) in @T_TFWG.lsp
	 )				;      ss = ss - ssss
       )
       (if ss
	 (progn
	   (command "erase" ss "")
					;(command "redraw")
	 )
       )
      )
    )					;*** end of (cond...
  )					;*** end of (while...
  (setvar "skpoly" m_skold)
  (setvar "clayer" "PP-COM")
  (pub_re_var)
  (princ)
)

;;;
;;; 8.离散
;;;
;;; 2002.07.25 thu by wei
;;; 增加识别SPLINE,仅仅识别,没有处理
;;;
;;;已知限制：若spline线的长度小与离散距离，这仍不能生成离散点（由于没有计算spline线长度的函数）

(defun dgx_ls_zs (flag cc   /	 psold	   dd	ss   ii	  e    bg
		  e0   sst  eb	 jj   et   app	entb lay  lp1  lp2
		  temp ptemp	 sp   ep   sp1	ep1  eb1  p01  p02
		  ss3
		 )
;;;参数lp1,lp2,temp,ptemp由任蔚青添加，2001／11／29
;;;lp1--多义线起点 lp2--多义线终点 temp--多义线端点表(逆序)
;;;ptemp -- 用measure等分多义线后最后一个生成的点坐标

  　
;;;参数eb由魏工添加，2002/7/25　
;;;参数eb--spline线的实体数据表

;;;参数sp,ep,sp1,ep1,eb1由任蔚青添加，2002／8／2
;;;sp--spline线起点　　　ep--spline线终点 　
  　
;;;eb1--spline线的拟合点表
;;;sp--spline线的第一个mesure点　　　ep--spline线的最后一个mesure点



  (szload pub_save_var "wwpublic")
  (pub_save_var)
  (setq m_skold (getvar "skpoly"))
  (setvar "skpoly" 1)

  (setq app (strcat (strcase flag) "BG"))
  (if (= (strcase flag) "ZR")
    (setq lay "PP-DX-DGXZ"
	      laypt "pp-dx-pt"
	)
    (setq lay "PP-DX-DGXS"
	      laypt "pp-sj-pt"
	)
  )
  (setvar "clayer" laypt)
  (setq psold (getvar "pdsize"))
  (setvar "pdsize" 1.0e-3)
  (setq dd -1)
  (while (<= dd 0)
     (progn
       (setq dd (getreal "\n离散点间距<10.0>:"))
       (if (= dd nil)
	    (setq dd 10.0)
       )
       (if (<= dd 0)
           (print "离散点间距必须大于0")
       )
     )
  )
  (setq	ss
	 (ssget	"x"
		(list '(0 . "POINT")
		      (cons 8 laypt)
		      (list -3 (list app))
		)
	 )
  )
  (if ss
    (progn
      (setq ii 0)
      (repeat (sslength ss)
	(setq e	 (ssname ss ii)
	      ii (1+ ii)
	)
	(if (= (HY_QQ10xx e app 1070) 1)
	  (entdel e)
	)
      )
    )
  )

;;;+++2002.07.25 thu add by wei
;;;注意：对于spline线，若spline的长度小与离散间距，程序没有处理（不离散）
  (setq ss (ssget "x" (list '(0 . "SPLINE") (cons 8 lay))))
  (if ss
    (progn
      (setq ii 0)
      (princ "\n 正在工作,请稍候.......")
      (repeat (sslength ss)
	(setq e	 (ssname ss ii)
	      eb (entget e)
	      bg (caddr (cdr (assoc 10 eb)))
	)
;;;;任蔚青2002/8/2  10:58 begin
	(setq eb1 (member (assoc 11 eb) eb))
	(if (= eb1 nil)
	  (progn
	    (setq eb1 (member (assoc 10 eb) eb))
	  )
	)

	(setq sp (cdr (nth 0 eb1)))
	;(setq sp (list (car sp) (cadr sp) 0.0))
	(if (= (cdr (assoc 74 eb)) 0)
	  (setq ep (cdr (assoc 10 (reverse eb))))
	  (setq ep (cdr (nth (- (cdr (assoc 74 eb)) 1) eb1)))
	)
	;(setq ep (list (car ep) (cadr ep) 0.0))

;;;;任蔚青2002/8/2  10:58 end

	(setq e0 (ent_last))
	(command ".measure" e dd)
	(setq sst (get_last e0))
	(if sst
	  (progn
	    (setq jj 0)
	    (repeat (sslength sst)
	      (setq et (ssname sst jj))
	      (HY_KZSJXZ et app 1040 bg 1070 1)

	      (if (= jj 0)
		(setq sp1 (cdr (assoc 10 (entget (entlast)))))
	      )
;;;任蔚青2002-8-2 11:35,保存第一个measure点
	      (setq jj (1+ jj))
	    )

;;;;任蔚青2002/8/2  11:00
	    (if	(> (distance sp sp1) (* dd 0.4))
	      (progn
		(command "point" sp)
		(setq et (ent_last))
		(HY_KZSJXZ et app 1040 bg 1070 1)
	      )
	    )
	    (setq ep1 (cdr (assoc 10 (entget (entlast)))))
	    (if	(> (distance ep ep1) (* dd 0.4))
	      (progn
		(command "point" ep)
		(setq et (ent_last))
		(HY_KZSJXZ et app 1040 bg 1070 1)
	      )
	    )
;;;;任蔚青2002/8/2  11:00


	  )
	  
	)

	(setq ii (1+ ii))
      )
    )
  )
;;;---

  (setq ss (ssget "x" (list '(0 . "*POLYLINE,LINE") (cons 8 lay))))
  (if ss
    (progn
      (setq ii 0)
      (princ "\n 正在工作,请稍候.......")
      (repeat (sslength ss)
	(&wait_bz)
	(setq e	    (ssname ss ii)
	      ptemp (cdr (assoc 10 (setq entb (entget e))))
	)
	(if (= (cdr (assoc 0 entb)) "POLYLINE")
	  (setq ptemp (cdr (assoc 10 (setq entb (entget (entnext e))))))
	)
	(setq
	  bg   (caddr ptemp)
	  temp (dw-ypp e)
	  e    (list e ptemp)
;;;;              temp (dw-ypp e)
;;;;             bg (caddr (cdr (assoc 10 (setq entb (entget e)))))
;;;              e  (list e '(0 0 0))
	)

	(if (= (cdr (assoc 0 entb)) "LWPOLYLINE")
;;;modi 1998.06.06
	  (setq bg (cdr (assoc 38 entb)))
	)
 
;;;	(setvar "elevation" bg)
	(setq e0 (ent_last))
	(if (> (#entlen (car e)) dd)
;;;11:11 99-1-22wbg
	  (progn
	    (command ".measure" e dd)
;;;add 2001/11/29 rwq
	    (setq ptemp (cdr (assoc 10 (entget (entlast)))))

	    (setq lp2 (car temp)
		  lp1 (car (reverse temp))
	    )
	    (setq lp1 (list (car lp1) (cadr lp1) bg))
	    (setq lp2 (list (car lp2) (cadr lp2) bg))

	    (command ".point" lp1)
	    (if	(> (distance lp2 ptemp) (* dd 0.4))
	      (command ".point" lp2)
	      nil
	    )
	  )
;;;add 2001/11/29 rwq
	

;;;;任蔚青增加，修正当实体长度小与等与离散间距时不能离散的错误2002-11-23 10:42
	(progn
;;;任蔚青修改2003-7-25 14:54，这样不能得到段实体的起终点 ----begin      	
;;	  (setq	temp (entget (car e))
;;	
;;		lp1  (cdr (assoc 10 temp))
;;		lp2  (cdr (assoc 10 (reverse temp)))
;;	  )
          (setq temp (dw-ypp (car e))
                lp1 (car temp)
                lp2 (car (reverse temp))
          )     
          (setq lp1 (list (car lp1)(cadr lp1) bg))
          (setq lp2 (list (car lp2)(cadr lp2) bg))
         
;;;任蔚青修改2003-7-25 14:54，这样不能得到段实体的起终点 ----end   
 	  (setq ss3 nil)
	  (setq p01 (polar lp1 (* 0.25 pi) 0.5))
	  (setq p02 (polar lp1 (* 1.25 pi) 0.5))
	  (setq	ss3 (ssget "W"
			   p01
			   p02
			   (list (cons 0 "POINT")
				 (cons 8 laypt)
				 (list -3 (list app))
			   )
		    )
	  )

	  (if ss3
	    nil
	     (command ".point" lp1)
	  )


	  (setq ss3 nil)
	  (setq p01 (polar lp2 (* 0.25 pi) 0.5))
	  (setq p02 (polar lp2 (* 1.25 pi) 0.5))
	  (setq	ss3 (ssget "W"
			   p01
			   p02
			   (list (cons 0 "POINT")
				 (cons 8 laypt)
				 (list -3 (list app))
			   )
		    )
	  )
	  (if ss3
	    nil
	    (command ".point" lp2)
	  )
;;;;任蔚青增加，修正当实体长度小与等与离散间距时不能离散的错误2002-11-23 10:42

	)
      )
;;;11:11 99-1-22wbg
	(setq sst (get_last e0))
	(if sst
	  (progn
	    (setq jj 0)
	    (repeat (sslength sst)
	      (setq et (ssname sst jj))
	      (HY_KZSJXZ et app 1040 bg 1070 1)
	      (setq jj (1+ jj))
	    )
	  )
	)
	(setq ii (1+ ii))
      )
      (princ "\n 正在工作,请稍候............OK!")
    )
  )
  (setvar "skpoly" m_skold)
  (setvar "pdsize" psold)
  ;;;(setvar "elevation" 0.0)
  (setvar "clayer" "PP-COM")
  (pub_re_var)
  (princ)
)

;;; 9.标注
(defun dgx_bz_zs ( flag /	apold lay   fftt  e	eb     bg	  hh
		  ww	p00   p01   p02	  ang	jiao  ee    eeb	  kk
		  ptb	eee   p12   p11	  v70　mp msg lays xh num_undo ns ns1
		  ss_dgx ptlist pt_10 lx bg0 angb ans anz dist_text
		 )
  (szload pub_save_var "wwpublic")
  (pub_save_var)
  (setq m_skold (getvar "skpoly"))
  (setvar "skpoly" 1)

  (HY_SV)
  (undo_m)
  (setq apold (getvar "aperture"))
  (setvar "aperture" (getvar "pickbox"))

  (if (= (strcase flag) "ZR")
      (setq lays  "PP-DX-DGXZ"
            msg "自然等高线"
      )
      (setq lays  "PP-DX-DGXS"
            msg "设计等高线"
      )
  )
  (setq hh (/ (Dl_GetTextHeight) (DL_GetDrawingFactor))) ;*** text high
  (setq ww (DL_GetDimPrec))		;*** 小数位数 ***

  (setq fftt t)
  (while fftt
    (initget "F")
    (setq e (nentsel (strcat "\n回车退出 /篱笆方式选择标注F /选取" msg ":")))
    (if (= (type e) 'LIST)
       (progn
         (setq lay (strcase (cdr (assoc 8 (entget (car e))))))
         (if (/= lay lays) (setq e "RETURN"))
       )  
    )
             
    (cond 
    ((= e "RETURN") (prompt (strcat "\n请选择" msg "!")))
    ((= e nil) (setq fftt nil))
    ((= e "F")
       (setq xh2 t)
       (setq num_undo 0)
       (while xh2
	 (initget "U")
	 (setq p01 (getpoint "\n 回车返回 /回退U /输入第一点:"))
	 (cond
	   ((= p01 nil) (setq xh2 nil))
	   ((= p01 "U")
	    (if	(= num_undo 0)
	      (prompt "\n 已经回退到最后!")
	      (progn
		(setq num_undo (- num_undo 1))
		(undo_b)
	      )
	    )
	   )
	   (t
	    (setq p02 (getpoint p01 "\n 回车重选第一点 /输入第二点:"))
	    (cond
	       ((= p02 nil) (setq p01 nil))
	       (t
		    (&view_ptb (list p01 p02))
		    (setq ss_dgx (ssget	"F"
					(list p01 p02)
					(list (cons 8 lays)
					      '(-4 . "<or")
					      '(0 . "LWPOLYLINE")
					      '(0 . "POLYLINE")
					      '(0 . "SPLINE")
					      '(-4 . "or>")
					)
				 )
		    )
		    (if	ss_dgx
		      (progn
			(setq num_undo (+ 1 num_undo))
		      	(undo_m)
			(setq ns  (sslength ss_dgx)
			      ns1 0
			 )
			(repeat	ns
			  (setq e (ssnamex ss_dgx ns1))
			  (setq	eb     (car e)
				e      (cadr eb)
				PtList (cdddr eb)
			  )
			    (setq	pt_10 (cadar PtList)
				eb    (entget e)
				lx    (cdr (assoc 0 eb))
				lay   (strcase (cdr (assoc 8 eb)))
			    )
			  (if (= lx "SPLINE")
			    (progn
			      (setq ent e)
			      (setq bg (get_dgxbg_builtin ent) )
			      (setq pt_10 (HY_QXPMZJD ent pt_10) )
			      (setq ang (HY_GetFirstDeriv ent pt_10) )
			      (setq angb (&hy_jxjhs ang)
					ans	 (car angb)
					anz	 (cadr angb)
			      )
			      (command "text" "j" "mc" pt_10 hh (hudtojd anz) (rtos bg 2 ww))
			      (HY_KZSJXZ (entlast) nil 8 lays)
			      (setq dist_text (&cal_tex_dis (entlast)) )
			      (command ".break" ent (polar pt_10 anz (* dist_text 0.5)) (polar pt_10 (+ anz pi) (* dist_text 0.5))  )
			    )
			    (progn
				    (if (= lx "LWPOLYLINE")
					    (setq bg0 (cdr (assoc 38 eb)))
					    (setq p00 (cdr (assoc 10 eb))
						  bg0 (caddr p00)
					    )
				    )
				    (if bg0
					    (progn
					      (setq pt_10 (HY_GetClosestPointTo e pt_10))
					      (setq ang (HY_GetFirstDeriv e pt_10))
					      (setq angb (&hy_jxjhs ang)
						    ans	 (car angb)
						    anz	 (cadr angb)
					      )
					      (command "text"
						       "J"
						       "M"
						       pt_10
						       hh
						       (* (/ anz pi) 180.0)
						       (rtos bg0 2 ww)
					      )
					      (HY_KZSJXZ (entlast) nil 8 lays)
					      (setq dist_text (&cal_tex_dis (entlast)) )
					      (command ".break" e (polar pt_10 anz (* dist_text 0.5)) (polar pt_10 (+ anz pi) (* dist_text 0.5))  )
					    )
			          )
			    )
			  )
			  (setq ns1 (+ ns1 1))
			)
		      )
		      (prompt "\n 没有选中等高线!")
		    )
	       )
	    )
	   )
	 )
       )
    )   
    ( t 
	(setq p00 (cadr e)
	      e	  (car e)
	      eb  (entget e)
	      lx  (cdr (assoc 0 eb))
	      lay (strcase (cdr (assoc 8 eb)))
	)
;;;-----------modi 1998.06.06
	(if (= lx "LWPOLYLINE")
	  (progn
	    (setq ptb (dw-ypp1 e p00)
		  p01 (cadr ptb)
		  p02 (caddr ptb)
		  ang (angle p01 p02)
	    )
	    (if	(equal ang (* 2.0 pi) 0.1)
	      (setq ang 0.0)
	    )
	    (if	(and (>= ang (* 0.5 pi)) (<= ang (* 1.5 pi)))
	      (setq ang (- ang pi))
	    )
	    (setq jiao (* (/ ang pi) 180.0))
	    (setvar "clayer" lay)
					;(setq bg (caddr p01))
	    (setq bg (cdr (assoc 38 eb)))
;;;bg
	    (setq p00 (osnap p00 "nea"))
	    (initget "C")
	    (setq
	      kk (getkword "\n垂直等高线标注 C /<沿等高线方向标注>:")
	    )
	    (if	(= kk "C")
	      (setq jiao (+ jiao 90.0))
	    )
	    (if	(and (> jiao 135.0) (<= jiao 315.0))
	      (setq jiao (- jiao 180.0))
	    )
	    (command "text" "j" "mc" p00 hh jiao (rtos bg 2 ww))
	    (setq kk  (textbox (list (cons 1 (rtos bg 2 ww))))
		  kk  (HY_PtPMDist (nth 0 kk) (nth 1 kk))
		  p01 (polar p00 ang (* 0.6 kk))
		  p02 (polar p00 ang (* -0.6 kk))
	    )

;;;;;任蔚青增加，修正当等高线为闭合pline线，
;;;;;而标注时两断开点方向与pline绘制方向不一致时，标注后等高线断开错误2002-11-23 9:55
	    (setq v70 (cdr (assoc 70 eb)))
	    (if	(and v70 (= (rem v70 2) 1))
	      (progn
		(setq mp  (getmid p01 p02)
		      p11 (polar p01 (+ ang (* 0.5 pi)) 0.5)
		      p01 (polar p01 (- ang (* 0.5 pi)) 0.5)
		      p12 (polar p02 (+ ang (* 0.5 pi)) 0.5)
		      p02 (polar p02 (- ang (* 0.5 pi)) 0.5)
		)
		(command "pline" p11 p01 p02 p12 "c")
		(setq eee (entlast))
		(command "trim" eee "" (list e mp) "")
		(entdel eee)
	      )
;;;progn
	      (command ".break" e p01 p02)
	    )
;;;;;任蔚青增加，修正当等高线为闭合pline线，
;;;;;而标注时两断开点方向与pline绘制方向不一致时，标注后等高线断开错误2002-11-23 9:55


;;;        (command ".break" e p01 p02)
	  )
	)
;;;-----------------

	(if (= lx "VERTEX") 
	  (progn
	    (setq p01 (cdr (assoc 10 eb))
		  ee  (entnext e)
	    )
	    (if	ee
	      (progn
		(setq eeb (entget ee))
		(if (= (cdr (assoc 0 eeb)) "VERTEX")
		  (progn
		    (setq p02 (cdr (assoc 10 eeb))
			  ang (angle p01 p02)
		    )
		    (if	(equal ang (* 2.0 pi) 0.1)
		      (setq ang 0.0)
		    )
		    (if	(and (>= ang (* 0.5 pi)) (<= ang (* 1.5 pi)))
		      (setq ang (- ang pi))
		    )
		    (setq jiao (* (/ ang pi) 180.0))
		    (setvar "clayer" lay)
		    (setq bg (caddr p01))
		    (setq p00 (osnap p00 "nea"))
		    (initget "C")
		    (setq
		      kk (getkword
			   "\n垂直等高线标注 C /<沿等高线方向标注>:"
			 )
		    )
		    (if	(= kk "C")
		      (setq jiao (+ jiao 90.0))
		    )
		    (if	(and (> jiao 135.0) (<= jiao 315.0))
		      (setq jiao (- jiao 180.0))
		    )
		    (command "text" "j" "mc" p00 hh jiao (rtos bg 2 ww))
		    (setq kk  (textbox (list (cons 1 (rtos bg 2 ww))))
			  kk  (HY_PtPMDist (nth 0 kk) (nth 1 kk))
			  p01 (polar p00 ang (* 0.6 kk))
			  p02 (polar p00 ang (* -0.6 kk))
		    )
		    (while (/= (cdr (assoc 0 eeb)) "SEQEND")
		      (setq ee	(entnext ee)
			    eeb	(entget ee)
		      )
		    )
		    (setq ee (cdr (assoc -2 eeb)))
		    (command ".break" ee p01 p02)
		  )
		)
	      )
	    )
	  )
	)
	(if (= lx "SPLINE")
	    (progn
	      (setq pt_10 p00  ee e)
	      (setq bg (get_dgxbg_builtin ee) )
	      (setq pt_10 (HY_QXPMZJD ee pt_10) )
	      (setq ang (HY_GetFirstDeriv ee pt_10) )
	      (setq jiao ang)
	      (initget "C")
	      (setq kk (getkword "\n垂直等高线标注 C /<沿等高线方向标注>:") )
	      (if (= kk "C") 
		    (progn
		      (setq ang (+ ang (* pi 0.5)) )
		    )
	      )
	      (setq angb (&hy_jxjhs ang)
			ans	 (car angb)
			anz	 (cadr angb)
	      )
	      (setvar "clayer" lay)
	      (command "text" "j" "mc" pt_10 hh (hudtojd anz) (rtos bg 2 ww))
	      (setq dist_text (&cal_tex_dis (entlast)) )

	      (if (= kk "C")
	          (progn
	              (setq angb (&hy_jxjhs jiao)
			    anz	 (cadr angb)
	              )
	          )
	      )
	      (command ".break" ee (polar pt_10 anz (* dist_text 0.5)) (polar pt_10 (+ anz pi) (* dist_text 0.5))  )
	    )
	  )  
      )
    )
  )
  (setvar "skpoly" m_skold)
  (setvar "aperture" apold)
  (HY_RV)
  (setvar "clayer" "PP-COM")
  (pub_re_var)
  (princ)
)



;;; 9.交叉口等高线标注,文字标注方向为等高线切线方向
(defun jckdgx_bz_zs (/	   apold lay   fftt  e	   eb	 lays  bg
		     hh	   ww	 p00   p01   p02   ang	 jiao  ee
		     eeb   kk	 ptb   num_undo	   angb	 ans   anz
		     bg0   pt_10 ns    ns1   PtList
		    )
  (szload pub_save_var "wwpublic")
  (pub_save_var)
  (setq m_skold (getvar "skpoly"))
  (setvar "skpoly" 1)
  (styrem)
  (HY_SV)
  (undo_m)
  (setq apold (getvar "aperture"))
  (setvar "aperture" (getvar "pickbox"))

  (setq lays "PP-DL-JCKDGX")
  (setq hh (/ (Dl_GetTextHeight) (DL_GetDrawingFactor))) ;*** text high
  (setq ww (DL_GetDimPrec))		;*** 小数位数 ***
  (setq	fftt t
	num_undo 0
  )
  (while fftt
    (setq
      e	(gpsseld
	  (list	(cons 8 lays)
		'(-4 . "<or")
		'(0 . "LWPOLYLINE")
		'(0 . "POLYLINE")
		'(0 . "SPLINE")
		'(-4 . "or>")
	  )
	  "\n回车退出 /回退U /篱笆方式选择标注F /选取要标注等高线:"
	  "U F"
	)
    )
    (cond
      ((= e nil) (setq fftt nil))
      ((= e "U")
       	(if (= num_undo 0)
	 			(prompt "\n 已经回退到最后!")
	 			(progn
	   			(setq num_undo (- num_undo 1))
	   			(undo_b)
	 			)
       )
      )
      ((= e "F")
       (setq xh2 t)
       (while xh2
	 (initget "U")
	 (setq p01 (getpoint "\n 回车返回 /回退U /输入第一点:"))
	 (cond
	   ((= p01 nil) (setq xh2 nil))
	   ((= p01 "U")
	    (if	(= num_undo 0)
	      (prompt "\n 已经回退到最后!")
	      (progn
		(setq num_undo (- num_undo 1))
		(undo_b)
	      )
	    )
	   )
	   (t
	    (setq p02 (getpoint p01 "\n 回车重选第一点 /输入第二点:"))
	    (&view_ptb (list p01 p02))
	    (setq ss_dgx (ssget	"F"
				(list p01 p02)
				(list (cons 8 lays)
				      '(-4 . "<or")
				      '(0 . "LWPOLYLINE")
				      '(0 . "POLYLINE")
				      '(0 . "SPLINE")
				      '(-4 . "or>")
				)
			 )
	    )
	    (if	(= ss_dgx nil)
	      (prompt "\n 没有选中等高线!")
	      (progn
		(setq num_undo (+ num_undo 1))
	      	(undo_m)
		(setq ns  (sslength ss_dgx)
		      ns1 0
		)
		(repeat	ns
		  (setq e (ssnamex ss_dgx ns1))
		  (setq	eb     (car e)
			e      (cadr eb)
			PtList (cdddr eb)
		  )
		  (setq	pt_10 (cadar PtList)
			eb    (entget e)
			lx    (cdr (assoc 0 eb))
			lay   (strcase (cdr (assoc 8 eb)))
		  )
		  ;;(if (or (= (cdr (assoc 0 eb)) "LWPOLYLINE")
			;;  (= (cdr (assoc 0 eb)) "SPLINE")
		  ;;    )
		  (if (= (cdr (assoc 0 eb)) "LWPOLYLINE")
		    (setq bg0 (cdr (assoc 38 eb)))
		    (setq p00 (cdr (assoc 10 eb))
			  bg0 (caddr p00)
		    )
		  )
		  (if bg0
		    (progn
		      (setq pt_10 (HY_GetClosestPointTo e pt_10))
		      (setq ang (HY_GetFirstDeriv e pt_10))
		      (setq angb (&hy_jxjhs ang)
			    ans	 (car angb)
			    anz	 (cadr angb)
		      )
		      (command "text"
			       "J"
			       "M"
			       pt_10
			       hh
			       (* (/ anz pi) 180.0)
			       (rtos bg0 2 ww)
		      )
		      (HY_KZSJXZ (entlast) nil 8 lays)
		    )
		  )
		  (setq ns1 (+ ns1 1))
		)
	      )
	    )
	   )
	 )
       )				;end of while xh2
      )
      ((= (type e) 'list)
       (setq p00 (cadr e)
	     			e	 (car e)
	     			eb	 (entget e)
	     			lx	 (cdr (assoc 0 eb))
	     			lay (strcase (cdr (assoc 8 eb)))
       )
       ;;(if (or (= (cdr (assoc 0 eb)) "LWPOLYLINE")
	     ;;  (= (cdr (assoc 0 eb)) "SPLINE")
	   		;;	)
	   	  (if (= (cdr (assoc 0 eb)) "LWPOLYLINE")
	 					(setq bg0 (cdr (assoc 38 eb)))
	 					(setq pt_10 (cdr (assoc 10 eb))
	      				 bg0   (caddr pt_10)
	 					)
       )
       (if bg0
				 (progn
				   (setq num_undo (+ num_undo 1))
				   (undo_m)
				   (setq pt_10 (HY_GetClosestPointTo e p00))
				   (setq ang (HY_GetFirstDeriv e pt_10))
				   (setq angb (&hy_jxjhs ang)
					 ans  (car angb)
					 anz  (cadr angb)
				   )
				   (command "text"
					    "J"
					    "M"
					    pt_10
					    hh
					    (* (/ anz pi) 180.0)
					    (rtos bg0 2 ww)
				   )
				   (HY_KZSJXZ (entlast) nil 8 lays)
				 )
       )
;;;-----------modi 1998.06.06
      )
    )
    ;;end of cond e
  )					;end of while
  (setvar "skpoly" m_skold)
  (setvar "aperture" apold)
  (HY_RV)
  (setvar "clayer" "PP-COM")
  (pub_re_var)
  (princ)
)


;;------------------------------
;; 1997.05.07 wed
;; 自动搜索等高线
;; return ==> ss
;;------------------------------
(defun ssdgx (/ ft e eb lay lx fhb p01 p02 ssss)
  (setq m_skold (getvar "skpoly"))
  (setvar "skpoly" 1)

  (setq ft t)
  (while ft
    (setq
      e	(HY_SelSingleEnt
	  "\n选取某等高线的任一段:"
	  "LINE,ARC,*POLYLINE"
	  "*"
	  nil
	)
    )
    (cond
      ((= e nil) (setq ft nil))
      ((= e "RETURN")
       (prompt "\n等高线只能是ARC,LINE或POLYLINE实体.")
      )
      (t
       (setq ft	 nil
	     e	 (car e)
	     eb	 (entget e)
	     lx	 (cdr (assoc 0 eb))
	     lay (strcase (cdr (assoc 8 eb)))
       )
       ;;lhr修改 处理圆弧
	    (cond 
	      ((= lx "LINE")
	        (setq p01	(cdr (assoc 10 eb))
		      p02	(cdr (assoc 11 eb))
	        )
	      )
	      ((= lx "ARC")
	        (setq fhb (getArcVetex e)
	              p01 (car fhb)
	              p02 (last fhb)
	        )
	       )
	      (t
	       (setq fhb (getvex e)
		     p01 (caar fhb)
		     p02 (car (last fhb))
         	)
	      )
	    )
	    ;;修改结束
      ;; (if (= lx "LINE")
	;; (setq p01 (cdr (assoc 10 eb))
	 ;;      p02 (cdr (assoc 11 eb))
	;; )
	;; (setq fhb (getvex e)
	;;       p01 (caar fhb)
	;;       p02 (car (last fhb))
	;; )
       ;;)
       (setq ssss (ssadd)
	     ssss (ssadd e ssss)
       )
       (setq ssss (ssdgx1 e p01 lay ssss)
	     ssss (ssdgx1 e p02 lay ssss)
       )
      )
    )
  )
  (setvar "skpoly" m_skold)
  ssss
)
;;------------------------------
;; 1997.05.07 wed
;; 自动搜索等高线1
;; return ==> ss
;;------------------------------
(defun ssdgx1 (e p00 lay ssss /	ptc1 ptc2 ss eb lx p01 p02 fhb ft jj
	       zoomp)
  (szload pub_save_var "wwpublic")
  (pub_save_var)
  (setq m_skold (getvar "skpoly"))
  (setvar "skpoly" 1)
  (setq	ft t
	jj 0
  )
  (while ft
    (setq jj (1+ jj))
    (if	(= (rem jj 10) 0)
      (prompt ".")
    )
    (setq ptc1 (polar p00 (* 0.25 pi) 0.1)
	  ptc2 (polar p00 (* 1.25 pi) 0.1)
    )
    (if	(HY_IsPtInView p00)
      (princ)
      (progn (zoomex) (setq zoomp 1))
    )
    (setq ss (ssget "c"
		    ptc1
		    ptc2
		    (list (cons 0 "LINE,ARC,*POLYLINE") (cons 8 lay))
	     )
    )
    (setq ss (ssdel e ss))
    (if	(= (sslength ss) 1)
      (progn
	(setq e (ssname ss 0))
	(if (ssmemb e ssss)
	  (setq ft nil)
	  (progn
	    (setq ssss (ssadd e ssss))
	    (setq eb (entget e)
		  lx (cdr (assoc 0 eb))
	    )
	    ;;lhr修改 处理圆弧
	    (cond 
	      ((= lx "LINE")
	        (setq p01	(cdr (assoc 10 eb))
		      p02	(cdr (assoc 11 eb))
	        )
	      )
	      ( (= lx "ARC")
	        (setq fhb (getArcVetex e)
	              p01 (car fhb)
	              p02 (last fhb)
	        )
	       )
	      (t
	       (setq fhb (getvex e)
		     p01 (caar fhb)
		     p02 (car (last fhb))
         	)
	      )
	    )
	    ;;修改结束
	    ;;(if	(= lx "LINE")
	      ;;(setq p01	(cdr (assoc 10 eb))
		;;    p02	(cdr (assoc 11 eb))
	      ;;)
	      ;;(setq fhb	(getvex e)
		;;    p01	(caar fhb)
		  ;;  p02	(car (last fhb))
	      ;;)
	    ;;)
	    (setq p00 (get1pt p01 p02 p00 "far"))
	  )
	)
      )
      (setq ft nil)
    )
  )
  (if zoomp
    (command ".zoom" "p")
  )
  (setvar "skpoly" m_skold)
  (setvar "clayer" "PP-COM")
  (pub_re_var)
  ssss
)
;;;=======================自然标高离散点==============================
;;;逐点输入自然标高
(defun c:zrd_sdef () 
(En_Reactor)
(setq *error* global_err)
(ddbg "zr")
(setq *error* nil)
(Un_Reactor)
)
;;;逐点输入设计标高
(defun c:sjd_sdef ()
 (En_Reactor)
 (setq *error* global_err)
 (ddbg "sj")
 (setq *error* nil)
 (Un_Reactor)
 )
;;;文本定义自然标高
(defun c:zrd_txtdef ()
(En_Reactor)
(setq *error* global_err)
(#zzrdbg "zr")
(setq *error* nil)
(Un_Reactor)
)
;;;文本定义设计标高
(defun c:sjd_txtdef ()
(En_Reactor)
(setq *error* global_err)
(#zzrdbg "sj")
(setq *error* nil)
(Un_Reactor)
)
;;;文件定义自然标高
(defun c:zrd_filedef ()
 (En_Reactor)
 (setq *error* global_err)
 (zrd_from_file 0)
 (setq *error* nil)
 (Un_Reactor)
)
;;;文件定义设计标高
(defun c:sjd_filedef ()
 (En_Reactor)
 (setq *error* global_err)
 (zrd_from_file 1)
 (setq *error* nil)
 (Un_Reactor)
)
;;;属性块定义自然标高
(defun c:sjd_sxkdef ()
 (En_Reactor)
 (setq *error* global_err)
 (szz_sxbg nil)
 (setq *error* nil)
 (Un_Reactor)
 )
 
 ;; 地形自然标高离散点块定义
(defun c:zrd_blockdef ()
  (En_Reactor)
  (#ppas "Earthwork")
  (d_blockdef "ZRBG")
  (#ppuas "Earthwork")
  (Un_Reactor)
  (princ)
)

;; 土方设计标高离散点块定义
(defun c:sjd_blockdef ()
  (En_Reactor)
  (#ppas "Earthwork")
  (d_blockdef "SJBG")
  (#ppuas "Earthwork")
  (Un_Reactor)
  (princ)
)

;;;快速转化自然标高
(defun c:zrd_trans ()
 (En_Reactor)
 (setq *error* global_err)
 (zrd_from_points 0)
 (setq *error* nil)
 (Un_Reactor)
 )
;;;快速转化设计标高
(defun c:sjd_trans () 
(En_Reactor)
(setq *error* global_err)
(zrd_from_points 1)
(setq *error* nil)
(Un_Reactor)
)
;;;自然点标高检查
(defun c:zrd_chk () 
(En_Reactor) 
(setq *error* global_err)
(dx_check_zrbgpt 0)
(setq *error* nil)
(Un_Reactor)
)
;;;设计点标高检查
(defun c:sjd_chk () 
(En_Reactor)
(setq *error* global_err)
(dx_check_zrbgpt 1)
(setq *error* nil)
(Un_Reactor)
)
;;;计算任意点自然标高
(defun c:zrd_calbg (/ key)
  (En_Reactor)
  (setq *error* global_err)
  (sdbg "zr")
  (setq *error* nil)
  (Un_Reactor)
)
;;;defun

;;;计算任意点设计标高
(defun c:sjd_calbg (/ key)
  (En_Reactor)
  (setq *error* global_err)
  (sdbg "sj")
  (setq *error* nil)
  (Un_Reactor)
)
;;;------------------------------
;;; 1998.03.02 mon
;;; 定点标高 lx = "zr"/"sj"
;;;------------------------------
(defun ddbg (lx / laypt pmold psold p00 ft app wg_zh wg_sca g_mark)
  (if (null pub_save_var)
    (#ppls "wwpublic")
  )
  (pub_save_var)
  (HY_UndoM)
  (if (= lx "zr")
    (progn
      (prompt "\n===== 定义离散点自然标高 =====")
      (setq app "ZRBG"
	        laypt "PP-DX-PT"
	  )
    )
    (progn
      (prompt "\n===== 定义离散点设计标高 =====")
      (setq app "SJBG"
	        laypt "PP-SJ-PT"
	  )
    )
  )
  (setq	wg_sca (DL_GetDrawingFactor)
	wg_zh  (/ (Dl_GetTextHeight) wg_sca)
  )
  (DL_MakeLayer laypt)
  
 ;;任蔚青2004-9-2 11:41屏蔽,修改重生问题
 ;; (setq	pmold (getvar "pdmode")
 ;;	psold (getvar "pdsize")
 ;; )
 ;; (setvar "pdmode" 0)
 
  (if (= ddbg~bg nil)
    (setq ddbg~bg 10.0)
  )
  (setq ft t)
  (while ft
    (initget "C L")
    (setq
      p00 (getpoint
	    "\n回车退出 /参照线定位 L /测量坐标定位 C /<离散点位置>:"
	  )
    )
    (cond
      ((= p00 nil) (setq ft nil))
      ((= p00 "C")
       (while
	 (setq p00 (g_xydw))
	  (#mark p00)
	  (Setq g_mark (entlast))
	  (@ddbg_bz p00 app)
	  (entdel g_mark)
       )
      )
      ((= p00 "L") (g_czhx app))
      (t
       (#mark p00)
       (Setq g_mark (entlast))
       (@ddbg_bz p00 app)
       (entdel g_mark)
      )
    )
  )
  (pub_re_var)
  (princ)
)
;;;wht 10/18/99
(defun @ddbg_bz	(xc_pt xc_app / bg)
	(HY_SV)
	(if (= lx "zr")
		(setq bg (getreal (strcat "\n自然标高<" (rtos ddbg~bg 2 3) ">:")))
		(setq bg (getreal (strcat "\n设计标高<" (rtos ddbg~bg 2 3) ">:")))
	)
	(if (= bg nil)
		  (setq bg ddbg~bg)
		  (setq ddbg~bg bg)
	)
	
  (setq xc_pt (z_p bg xc_pt))
  (command ".point" xc_pt)
  (HY_KZSJXZ (entlast) xc_app 1040 bg)
  (szdl_ins_sysblk
    "g_donut"
    (p# xc_pt)
    (/ 1.0 wg_sca)
    (/ 1.0 wg_sca)
    0
  )
  (command "_.chprop" (entlast) "" "C" 3 "")
  (command "_.text"
	   "J"
	   "ML"
	   (polar (p# xc_pt) 0.0 (/ 1.5 wg_sca))
	   wg_zh
	   0.0
	   (rtos bg 2 3)
  )
  (HY_RV)
)
;;;------------------------------
;;; 1998.03.02 mon
;;; 算点标高 lx = "zr"/"sj"
;;;------------------------------
(defun sdbg (lx / laypt pmold psold p00 bg ft app cc hh lay flag w_triangle)
(defun sdbg_error(ccc / )
 (DL_Destory_TRiAngle w_triangle)
)
  (pusherr sdbg_error)
  (HY_Set0)
  (setq hh (/ (Dl_GetTextHeight) (DL_GetDrawingFactor))) ;*** text high
  (if (= lx "zr")
    (progn
      (prompt "\n===== 计算任意点自然标高 =====")
      (setq app	"ZRBG"
	    cc	"自然标高"
	    lay	"PP-DX-DGXZ"
		laypt "PP-DX-PT"
      )
    )
    (progn
      (prompt "\n===== 计算任意点设计标高 =====")
      (setq app	"SJBG"
	    cc	"设计标高"
	    lay	"PP-DX-DGXS"
		laypt "PP-SJ-PT"
      )
      )
    )
      (setq w_triangle (DL_InitTriangle app laypt))
      
 ;;任蔚青2004-9-2 11:41屏蔽,修改重生问题
;;      (setq pmold (getvar "pdmode")
;;	    psold (getvar "pdsize")
;;      )
;;      (setvar "pdmode" 0)

      (DL_MakeLayer lay)
      (setq ft t)
      (setq flag nil)
      (while ft
	(initget "C")
	(setq p00 (getpoint "\n回车退出 / 测量坐标定位 C /<点位置>:"))
	(cond
	  ((= p00 nil) (setq ft nil))
	  ((= p00 "C") (setq p00 (g_xydw)))
	)
	(if (and p00 (= (type p00) 'LIST))
	  (progn
	    ;;原来采用的是(command "zoom" "p")，这样，选择点为屏幕中间的点，
	    ;;不需要进行视图放缩时，程序会出错   modify by gudexing 2003.1.22    begin
	    (command "view" "s" "aaa")
	    (setq bg (GetPtBg_Triangle w_triangle p00))
            (if (null bg)  (setq bg (p_ptbg p00 app laypt)))
	    ;;(setq bg (p_ptbg p00 app laypt))
	    (command "view" "r" "aaa")
	    ;;(command "zoom" "p")
	    ;;原来采用的是(command "zoom" "p")，这样，选择点为屏幕中间的点，
	    ;;不需要进行视图放缩时，程序会出错   modify by gudexing 2003.1.22    end
	    (if	(eval bg)
	      (progn
		(prompt (strcat "\n" cc (rtos bg 2 3)))
		(initget "Y N")
		(if (= flag nil)
		  (setq
		    kk (getkword (strcat "\n是否标注(Y/N) <" "N>:"))
		  )
		  (setq
		    kk (getkword (strcat "\n是否标注(Y/N) <" "Y>:"))
		  )
		)

;;;flag为上一次是否标注标志,初始值为不标注nil
		(if (= flag nil)
		  (progn
;;;上一次为不标注
			 (if (= kk "Y")
			   (progn
;;;本次为标注
				  (command "text"
					   "j"
					   "mc"
					   p00
					   hh
					   0.0
					   (rtos bg 2 3)
				  )
				  (setq flag 1)
			   )
;;;progn
			   (progn
;;;本次为不标注
				  (setq flag nil)
			   )
;;;progn
			 )
;;;if
		  )
;;;progn
		  (progn
;;;上一次为不标注
			 (if (/= kk "N")
			   (progn
;;;本次为标注
				  (command "text"
					   "j"
					   "mc"
					   p00
					   hh
					   0.0
					   (rtos bg 2 3)
				  )
				  (setq flag 1)
			   )
			   (progn
;;;本次为不标注
				  (setq flag nil)
			   )
;;;progn
			 )
;;;if
		  )
;;;progn
		)
;;;if

	      )
	      (prompt "\n 指定点标高无法计算!")
	    )
	  )
	)
      )
;;      (setvar "pdmode" pmold)
;;      (setvar "pdsize" psold)
      (DL_Destory_TRiAngle w_triangle)
  (clr_err)
  (HY_RV)
)

;;------------------------------
;; 测量坐标定位 R
;;------------------------------
(defun g_xydw (/ x y p1)
  (setq y (getreal "\n回车结束 / 横坐标<Y>:"))
  (if y
    (progn
      (initget 1)
      (setq x (getreal "\n纵坐标<X>:"))
      (setq p1 (HY_TransCoord (list x y 0.0) 1))
    )
    nil
  )
)
;;;----------------------------------------------------
(defun g_czhx (xc_app	/	 w_glb	  w_prm1   w_prm2   w_entb
	       w_ent	w_pt	 w_pt0	  w_type   w_sp	    w_ep
	       w_ptb	w_mark	 w_oldp	  w_pt1	   w_ang0   w_arrw
	       w_ang	w_dis	 w_thep
	      )
  (if (null pub_arrow_wmk)
    (#ppls "wwpublic")
  )
  (if (or (null $p_to_e) (null $qtyd1))
    (#ppls "pppp")
  )
;;;确定基线
  (setq	w_glb  '((0 . "LINE,*POLYLINE"))
	w_prm1 "\n回车重新确定 /请指定参照线:"
	w_prm2 "没选中参照线,请重选!"
  )
  (setq w_entb ($p_to_e w_prm1 w_prm2 w_glb 512))
;;;确定基点
  (if w_entb
    (progn
      (setq w_ent (car w_entb)
	    w_pt  (cadr w_entb)
      )
      (setq w_pt0 (getpoint "\n回车返回 / 请在参照线上选一基准点:"))
      (if w_pt0
	(progn
	  (setq w_type (cdr (assoc 0 (entget w_ent))))
	  (if (= w_type "LINE")
	    (setq w_sp (p# (cdr (assoc 10 (entget w_ent))))
		  w_ep (p# (cdr (assoc 11 (entget w_ent))))
	    )
	    (setq w_ptb	(dw-ypp1 w_ent w_pt)
		  w_sp	(cadr w_ptb)
		  w_ep	(caddr w_ptb)
	    )
	  )
	  (setq w_pt0 ($qtyd1 w_pt0 w_sp w_ep))
	)
      )
    )
    (setq w_pt0 nil)
  )
;;;确定参照方向
  (if w_pt0
    (progn
      (#mark w_pt0)
      (setq w_mark (entlast)
	    w_oldp w_pt0
      )
      (initget 1)
      (setq w_pt1 (getpoint w_pt0 "\n请点示零度角方向:"))
      (setq w_pt1  ($qtyd1 w_pt1 w_sp w_ep)
	    w_ang0 (angle w_pt0 w_pt1)
      )
      (pub_arrow_wmk w_pt0 w_ang0)
      (setq w_arrw (entlast))
    )
    (setq w_ang0 nil)
  )
  (while w_ang0
    (setq w_ang (getreal "\n回车结束 / 顺时针旋转角度(度):"))
    (if	(null w_ang)
      (setq w_ang0 nil)
      (progn
	(setq w_ang (- w_ang0 (dtor w_ang)))
	(if w_arrw
	  (command "_.erase" w_arrw "")
	)
	(pub_arrow_wmk w_pt0 w_ang)
	(setq w_arrw (entlast))
	(initget 1)
	(setq w_dis (getreal "\n回车结束 / 距基准点距离:"))
	(setq w_thep (polar w_pt0 w_ang w_dis))
	(zm2pt w_pt0 w_thep)
	(command "_.move" w_mark "" w_oldp w_thep)
	(setq w_oldp w_thep)
	(@ddbg_bz w_thep xc_app)
      )
    )
  )
;;;end (while w_ang0
  (if w_mark
    (entdel w_mark)
  )
  (if w_arrw
    (entdel w_arrw)
  )
)

;;;-----------------------------
;;;1998.04.18
;;;由图面中表示自然标高高程的文字定义自然标高点
;;;-----------------------------
(defun #zzrdbg (lx / pmold psold ft e eb lay	ss kk pt tex len n bg
		flag app cc msg　referent w_scale ent minpt maxpt viewpt w_ucspt  
	 singe sign )
		(setvar "ORTHOMODE" 0)
		;;;;;;; add by wzy 2003-9-23 12:44 begin
	(defun GetReferEnt (key  / pt  ent　ss)
		(if(null key)
			(progn
				(initGet "P B A D G E")
				(setq key (getkword "\n点定位 P /块定位 B / 圆定位 A / 圆环定位 D / 点取定位 G / 椭圆定位 E／<回车 文字左下角>"))
		
			)
		)
		
		(cond 
			((null key) 
				(setq pt nil)
				"RETURN"
			)
			((= key "B")
				(setq msg "\n>>选择一个用于定位的图块:")
				(setq ent (HY_SelSingleEnt msg "INSERT" nil nil nil))	
				(cond
				((= ent "RETURN")
	       (prompt "\n没选中块或选中实体不是块!")
	       nil
	      )
	      (t
	      	(setq ent (car ent))
	      )
					
				)
			)
			((= key "A")
				(setq msg "\n>>选择一个用于定位圆:")
				(setq ent (HY_SelSingleEnt msg "CIRCLE" nil nil nil))	
				(cond
				((= ent "RETURN")
	       (prompt "\n没选中圆或选中实体不是圆!")
	       nil
	      )
	      (t
	      	(setq ent (car ent))
	      )
					
				)
			)
			((= key "E")
				(setq msg "\n>>选择一个用于定的椭圆: ")
				(setq ent (HY_SelSingleEnt msg "ELLIPSE" nil nil nil))	
				(cond
				((= ent "RETURN")
	       (prompt "\n没选中椭圆或选中实体不是椭圆!")
	       nil
	      )
	      (t
	      	(setq ent (car ent))
	      )
					
				)
			)
			((= key "P")
				(setq msg "\n>>择一个用于定位点:")
				(setq ent (HY_SelSingleEnt msg "POINT" nil nil nil))	
				(cond
				((= ent "RETURN")
	       (prompt "\n没选中点或选中实体不是点!")
	       nil
	      )
	      (t
	      	(setq ent (car ent))
	      )
					
				)
			)
			((= key "D")
				(setq msg "\n>>请选择一个用于定位圆环:")
				(setq	ent (HY_SelSingleEnt msg (list '(0  .  "*POLYLINE")(cons 42  1.0) ) nil nil nil ));;  
				(cond
				((= ent "RETURN")
	       (prompt "\n没选中圆环或选中实体不是圆环!")
	       nil
	      )
	      (t
	      	(setq ent (car ent))
	      )
					
				)
				
				
			)
			((= key "G")
			 (princ "\n>>请点取定位点:")
			 (setq pt (getpoint))
			 (if (null pt) 
			   (progn
			     (prompt "\n没有点取一个用于定位的点!")
			      nil
			    )
			    pt
			 )
		  )
		)
		
	)
	;;;; add by wzy 2003-9-23 12:44 end 
	
  
  (szload getlay "szdltool")
  (szload JZZ_DisplayPercent "pppp")
  (szload laycz "szdltool")
  (#ppas "Earthwork")
  (#ppls "pppp")
  (HY_Set0)
  (setq w_scale 3.0);;;求参考点时的方缩比例
 ;; (setq	pmold (getvar "pdmode")
 ;;	psold (getvar "pdsize")
 ;; )
 ;; (setvar "pdmode" 35)
 ;; (setvar "pdsize" 3.0)
  (if (= lx "zr")
    (progn
      (setq cc "自然标高")
      (setq app "ZRBG")
	  (setq laypt "PP-DX-PT")
    )
    (progn
      (setq cc "设计标高")
      (setq app "SJBG")
	  (setq laypt "PP-SJ-PT")
    )
  )
  (DL_MakeLayer laypt)
  (setq	msg (strcat "\n===== 通过图面中表示"
		    cc			   "高程的文字来定义离散点"
		    cc			   "====="
		   )
  )
  (setq	ss
	 (ssget	"x"
		(list '(0 . "POINT") (cons 8 laypt) (list -3 (list app)))
	 )
  )

  (if ss
    (setq flag nil);;;表示图面上没有点
    (setq flag 1);;;表示图面上有点
  )

  (prompt msg)
  (setq ft t)
  (setq msg (strcat "\n回车退出 / 选择表示" cc "高程的任一文字:"))
  (while ft
    (setq e (HY_SelSingleEnt
	      msg "TEXT" nil nil nil)
    )
    (cond
      ((null e) (setq ft nil))
      ((= e "RETURN")
       (beep)
       (prompt "\n没选中指定文字或所选实体不是文字!")
      )
      (t
       (HY_UndoM)
       (DL_MakeLayer laypt)
       (setq e	 (car e)
	     eb	 (entget e)
	     lay (strcase (cdr (assoc 8 eb)))
	     ppt (cdr (assoc 10 eb))
	     ft	 nil
       )
       (setq key nil)
       (setq sign t)
       (setq referent (getreferent key))
       (if (or (null referent ) (= referent "RETURN"))
            (progn
              (setq tmpx 0
									  tmpy 0
									  tmpz 0
					   	)
					   	(if (null referent )
					   		(progn
					   			(initget 128 "Y N")
			     				(setq key (getkword "\n没有选中参照实体,是否用文字的左下角定位(Y/N)?<N>"))	     				
			     				(if (or (= key "N") (null key))
			     					(setq sign nil)
			     				)
					   		)
					   		(setq referent nil)
					   	)   	
					   	
	     				;;(princ (list "\n key" key))
	      			;;(princ "\n 用文字左下角定位高程点!")
	    			)
            (if  (= (type referent) 'LIST)
		         (progn
		         		(setq dwpt referent
		               tmpx (- (car dwpt) (car ppt))
		               tmpy (- (cadr dwpt) (cadr ppt))
		               tmpz 0
		         		)
		         		
		         )
	    			)
       )
       
        ;;;;;;;;;;;;;;;
       (prompt (strcat "\n 选择" lay "层的" "TEXT实体" ",请选择:"))
       (setq chlayer "N")
       (while (and sign (setq ss (ssget (list (cons 0 "TEXT") (cons 8 lay)))))
				 (if  ss 
				   (progn
				     (initget 128 "Y N")
				     (setq key (getkword (strcat "\n 转换文字的图层Y / <" chlayer ">")))
				     (if (= key "Y")
				     	(command "layer"   "U" lay  "")
				    	)
				     (if key (setq chlayer key))
				     (setq newlayer (strcat lay "LSDTMP"))
				     (if (and (= chlayer "Y") (null (getlay newlayer))) (command "layer" "n" newlayer ""))
				     (setq len (sslength ss)
					   n   0
				     )
				     (setq viewpts (qdqpmd))
				     (viewss ss)
				     (princ "\n正在工作,请稍候......\n")
				     (repeat len
				       (JZZ_DisplayPercent "已完成" n len)
				       (setq ent (ssname ss n)
				             eb	 (entget ent)
					     tex (cdr (assoc 1 eb))
				       )
				       (setq tex (cdr (assoc 1 eb)))
				       (if (HY_IsNum tex)
				         (progn
				           (if (and referent (not (equal (type referent) 'LIST)))
						       	  (progn;;;非文字左下角定位方式或文字精确点定位
						       	  (setq dwpt (getlocatept ent referent w_scale))
						       		(if dwpt
						       		  (progn
						       		     (setq bg    (atof tex))
											     (setq pt (list (car dwpt) (cadr dwpt) bg))
												 (setq filter (list '(0 . "POINT")(cons 8 laypt)(list -3 (list app))))
											     (if (or flag  (not (IsPtInList_PlaneXY dwpt (ssget pt filter))))
													(progn
														(command ".point" pt)
														(HY_KZSJXZ (entlast) app 1040 bg)
														(if (= chlayer "Y")
															(command "change" ent "" "p" "la" newlayer "")
														)
													)
												)
										)
								  )
				       	 	);;;;;;;非文字左下角定位方式------
				       	 	(progn
					           (setq bg    (atof tex)
					                 pt    (z_p bg (cdr (assoc 10 eb)))
					                 tempx (car pt)
					                 tempy (cadr pt)
					                 tempz (caddr pt)
					                 pt    (list (+ tempx tmpx) (+ tempy tmpy) (+ tempz tmpz))
					           )
					           (if   (or flag (not (ssget pt (list '(0 . "POINT")
							                                (cons 8 laypt)
							                                (list -3 (list app))
							                         )
						                       )
					                           )
					                 )
					            (progn
					               (command ".point" pt)
					               (HY_KZSJXZ (entlast) app 1040 bg)
					               (if (= chlayer "Y") (command "change" ent "" "p" "la" newlayer ""))
					            )
					          )
				           )
				      	     )
				       	  );;;;是数字就处理------
				       )
				       (setq  n	 (1+ n))
				     );;;repeat
				     (command "zoom"  "w" (car viewpts)(cadr viewpts))
				     ;;(&view_ptb viewpts)
				     (princ "\n..........................OK!")
				     
			           );;;progn
			          );;;if ss
	);;;while
       (prompt "\n可用Undo/Back命令取消上次操作.")
      );;;t
    );;;cond
  );;;while ft
  (#ppuas "earthwork")
 ;; (setvar "pdmode" pmold)
 ;; (setvar "pdsize" psold)
  (HY_set1)
  (princ)
)


(defun dx_check_zrbgpt (xc_bglx   /         w_min_bg  w_sspt bg_input
                        w_ent     w_ptbg    w_max_bg  w_ii
                        w_prom    w_ss_del  w_key     w_sslen
                        w_pt      w_edel    w_goon    w_prom_no bz_delall
                       )
  (szload pub_save_var "wwpublic")
  (pub_save_var)
  (if (= xc_bglx 0)
    (setq
      w_sspt
                (ssget '((0 . "POINT") (8 . "PP-DX-PT") (-3 ("ZRBG"))))
      w_prom_no
                "没发现自然标高离散点!"
    )
    (setq
      w_sspt
                (ssget '((0 . "POINT") (8 . "PP-SJ-PT") (-3 ("SJBG"))))
      w_prom_no
                "没发现设计标高离散点!"
    )
  )

  (if (/= w_sspt nil)
    (progn
      (setq w_goon t)
      (while w_goon
        (initget 1)
        (setq w_min_bg (getreal "\n 请输入最小控制标高:"))
        (initget 1)
        (setq w_max_bg (getreal "\n 请输入最大控制标高:"))
        (if (>= w_min_bg w_max_bg)
          (DL_MsgOK "最小标高必须小于最大标高,请重输!")
          (setq w_goon nil)
        )
      )
      (setq w_ii 0)
      (setq w_ss_del (ssadd) bz_delall nil)
      (while (> (sslength w_sspt) 0)
        (setq w_ent (ssname w_sspt 0))
        (ssdel w_ent w_sspt)
          (if (= xc_bglx 0)
              (setq w_ptbg (HY_qq10xx w_ent "ZRBG" 1040))
              (setq w_ptbg (HY_qq10xx w_ent "SJBG" 1040))
          )
          (setq  w_ptbg_2 (caddr (cdr (assoc 10 (entget w_ent)))))
        ;;把扩展数据与Z值不相等的情况与标高不在指定范围的情况区别对待 begin
        ;;modify by gudexing 2003.1.22
        (cond
         ((or (null w_ptbg) (not (equal w_ptbg w_ptbg_2 0.001)) )
          (setq w_pt (cdr (assoc 10 (entget w_ent))))
          (pan2v w_pt)
          (setq w_edel (#mark w_pt))
          (if (= w_ptbg nil)  (setq w_ptbg w_ptbg_2)  )
          (if (= bz_delall nil)
           (progn
            (initget "E A")
            (setq bg_input (getreal (strcat "\n 标志处标高点标高被破坏：全部删除这类点A /删除该点E /输入该点正确标高<" (rtos w_ptbg 2 3) ">:")) )
           )
          )
          (cond
            ((= bg_input "A")
	           (setq bz_delall t)
             (command "_.erase" w_ent "")
	          ) 
            ((null bg_input)
				(if (= xc_bglx 0)
					(HY_kzsjxz w_ent "ZRBG" 1040 w_ptbg 10 (list (car w_pt) (Cadr w_pt) w_ptbg))
					(HY_kzsjxz w_ent "SJBG" 1040 w_ptbg 10 (list (car w_pt) (Cadr w_pt) w_ptbg))
				)
            )
            ((= bg_input "E")
             (command "_.erase" w_ent "")
            )
            (t
				(if (= xc_bglx 0)
					(HY_kzsjxz w_ent "ZRBG" 1040 bg_input 10 (list (car w_pt) (Cadr w_pt) bg_input))
					(HY_kzsjxz w_ent "SJBG" 1040 bg_input 10 (list (car w_pt) (Cadr w_pt) bg_input))
				)
             
            )
          )
          (command "_.erase" w_edel "")
         )
        ;;modify by gudexing 2003.1.22
        ;;把扩展数据与Z值不相等的情况与标高不在指定范围的情况区别对待 end
         ((or (< w_ptbg w_min_bg) (> w_ptbg w_max_bg))
            (ssadd w_ent w_ss_del)
            (setq w_ii (1+ w_ii))
          )
        )
      )
      (if (> w_ii 0)
        (progn
          (setq
            w_prom (strcat "经过检查，共有 " (itoa w_ii) "个无效点!")
          )
          (DL_MsgOK w_prom)
;;-----------------------------
          (setq w_goon t)
          (setq w_ss_add (ssadd))
          (while w_goon
            (if (> (sslength w_ss_del) 0)
              (progn
                (setq w_ent (ssname w_ss_del 0))
                (ssdel w_ent w_ss_del)
                (setq w_pt (cdr (assoc 10 (entget w_ent))))
                (pan2v w_pt)
                (setq w_edel (#mark w_pt))
		(prompt (strcat "\n 该点标高 : " (rtos (caddr w_pt) 2 3)))
                (initget "A X E")
                (setq w_key (getkword
                              "\n 退出 X / 全部删除 A / 删除该点 E / <回车下一点>:"
                            )
                )
                (cond
                  ((null w_key)
                   (ssadd w_ent w_ss_add)
                  )
                  ((= w_key "X")
                   (setq w_goon nil)
                  )
                  ((= w_key "A")
                   (command "_.erase" w_ent "")
                   (command "_.erase" w_ss_del "")
                   (command "_.erase" w_ss_add "")
                   (setq w_goon nil)
                  )
                  ((= w_key "E")
                   (command "_.erase" w_ent "")
                  )
                )
                (command "_.erase" w_edel "")
              )
              (progn
                (setq w_goon nil)
                (prompt "\n 已经全部处理!")
              )
            )
          )
        )
        (DL_MsgOK "没发现无效点!")
      )
    )
    (prompt w_prom_no)
  )

  (pub_re_var)
  (princ)
)
;;;文件定义
(defun zrd_from_file (xc_lx    /	w_fn	 w_appn	  w_hf
		      w_ii     w_data	w_datb	 w_xdat	  w_ydat
		      w_zdat   w_x	w_y	 w_z	  w_locp
		      w_sca    w_blk_sc	w_txth	 w_offd	  w_txtp
		     )
  (szload pub_save_var "wwpublic")
  (pub_save_var)
  (setq	w_sca	 (DL_GetDrawingFactor)
	w_blk_sc (/ 1.0 w_sca)
	w_txth	 (/ (Dl_GetTextHeight) w_sca)
	w_offd	 (/ 2.0 w_sca)
  )
  (if (= xc_lx 0)
	(setq w_appn "ZRBG"
		  laypt "PP-DX-PT"
	)
	(setq w_appn "SJBG"
		  aypt "PP-SJ-PT"
	)
  )
  (DL_MakeLayer laypt)
  (setq w_fn (getfiled "选择标高数据文件" "" "" 4))
  (if w_fn
    (progn
      (HY_SV)
      (setq w_hf (open w_fn "r"))
      (setq w_ii 1)
      (princ "\n 正在工作，请稍候......")
      (while (setq w_data (read-line w_hf))
	(&wait_bz)
	(setq w_datb (HY_SeparateString w_data))
	(if (< (length w_datb) 3)
	  (prompt (strcat "\n第 <" (itoa w_ii) "> 行数据无效!"))
	  (progn
	    (setq w_xdat (car w_datb)
		  w_ydat (cadr w_datb)
		  w_zdat (caddr w_datb)
	    )
	    (if	(and (HY_IsNum w_xdat)
		     (HY_IsNum w_ydat)
		     (HY_IsNum w_zdat)
		)
	      (progn
		(setq w_x (atof w_xdat)
		      w_y (atof w_ydat)
		      w_z (atof w_zdat)
		)
		(setq w_locp (HY_TransCoord (list w_x w_y w_z) 1))
		(command "_.point" w_locp)
		(HY_KZSJXZ (entlast) w_appn 1040 w_z)
		(setq w_locp (list (car w_locp) (cadr w_locp) 0.0))
		(szdl_ins_sysblk "g_donut" w_locp w_blk_sc w_blk_sc 0)
		(setq w_txtp (polar w_locp 0 w_blk_sc))
		(command "_.text" w_txtp w_txth 0 w_zdat)
	      )
	      (prompt (strcat "\n第 <" (itoa w_ii) "> 行数据无效!"))
	    )
	    ;;end of (if	(and (HY_IsNum w_xdat)
	  )
	)
	;;end of (if (< (length w_datb) 3)
	(setq w_ii (1+ w_ii))
      )
      (princ ".............OK!")
      (if w_hf
	(close w_hf)
      )
      (HY_RV)
    )
  )
  (pub_re_var)
  (princ)
)
(defun zrd_from_points (xc_lx	 /	  m_appn   m_prm1   m_prm2
			m_tmpl_pt	  m_eb	   m_glb    m_layb
			m_z	 m_sspt	  m_ii	   m_ssl    m_pt
			m_kk	 w_sca	  w_blk_sc w_txth   w_offd
			w_etype	 w_pb	  w_locp
		       )
  (szload $p_to_e "pppp")
  (setq	w_sca	 (DL_GetDrawingFactor)
	w_blk_sc (/ 1.0 w_sca)
	w_txth	 (/ (Dl_GetTextHeight) w_sca)
	w_offd	 (/ 2.0 w_sca)
  )
  (if (= xc_lx 0)
    (setq m_appn "ZRBG"
	      laypt "PP-DX-PT"
	)
    (setq m_appn "SJBG"
	      laypt "PP-SJ-PT"
	)
  )
  (setq	m_prm1 "\n 回车退出 / 选择样点:"
	m_prm2 "\n 没选中指定实体,请重选!"
  )
  (setq
    m_tmpl_pt ($p_to_e m_prm1 m_prm2 '((0 . "POINT,LWPOLYLINE")) nil)
  )
  (if m_tmpl_pt
    (progn
      (setq m_tmpl_pt (car m_tmpl_pt)
	    m_eb      (entget m_tmpl_pt)
	    m_layb    (assoc 8 m_eb)
	    w_etype   (cdr (assoc 0 m_eb))
	    m_glb     (list (cons 0 w_etype) m_layb)
	    m_z	      (last (cdr (assoc 10 m_eb)))
      )
      (prompt
	(strcat	"\n 下面将把您选择的 <"
		(cdr m_layb)
		"> 层的所有同类实体转化为自然标高离散点!"
	)
      )
      ;;转化点实体
      (if (= w_etype "POINT")
	(progn
	  (setq m_sspt (ssget m_glb))
	  (if m_sspt
	    (progn
	      (setq m_ssl (sslength m_sspt))
	      (DL_MakeLayer laypt)
	      (setq m_ii 0)
	      (while (< m_ii m_ssl)
		(setq m_pt (ssname m_sspt m_ii))
		(setq w_locp (cdr (assoc 10 (entget m_pt)))
		      m_z    (last w_locp)
		      m_txtz (rtos m_z 2 3)
		)
		(HY_KZSJXZ m_pt m_appn 8 laypt 1040 m_z)
		(setq m_ii (1+ m_ii))
		(szdl_ins_sysblk "g_donut" w_locp w_blk_sc w_blk_sc 0)
		(setq w_txtp (polar w_locp 0 w_blk_sc))
		(command "_.text" w_txtp w_txth 0 m_txtz)
	      )
	      (prompt "\n 转化成功完成!")
	    )
	  )
	)
      )
      ;;转化donut
      (if (= w_etype "LWPOLYLINE")
	(progn
	  (setq m_sspt (ssget m_glb))
	  (if m_sspt
	    (progn
	      (setq m_ssl (sslength m_sspt))
	      (DL_MakeLayer laypt)
	      (setq m_ii 0)
	      (while (< m_ii m_ssl)
		(setq m_pt (ssname m_sspt m_ii))
		(setq m_ii (1+ m_ii))
		(setq w_pb (bg-ypp m_pt))
		(if (= (length w_pb) 2)
		  (progn
		    (setq w_locp (midpt (car w_pb) (cadr w_pb))
			  m_z	 (cdr (assoc 38 (entget m_pt)))
			  m_txtz (rtos m_z 2 3)
		    )
		    (command "_.point"
			     (list (car w_locp) (cadr w_locp) m_z)
		    )
		    (HY_KZSJXZ (entlast) m_appn 8 laypt 1040 m_z)
;;;                    (szdl_ins_sysblk
;;;                      "g_donut"
;;;                      w_locp
;;;                      w_blk_sc
;;;                      w_blk_sc
;;;                      0
;;;                    )
		    (setq w_txtp (polar w_locp 0 w_blk_sc))
		    (command "_.text" w_txtp w_txth 0 m_txtz)
		  )
		)
	      )
	      (prompt "\n 转化成功完成!")
	    )
	  )
	)
      )
    )
  )
  (setvar "clayer" "PP-COM")
  (princ)
)


					;--------------由属性块定义标高 ---------------------------*****
(defun szz_sxbg	(tkmb	 /	 xh	 enb2	 ent2	 glb
		 ss	 ns	 ns1	 p01	 wb	 biao
		 str_tkm str_tmp tmp_tkmb	 xh2	 ns_pos
		 bg_tmp	 bz_srz	 real_tmp
		)
  (setvar "cmdecho" 0)
  (setvar "blipmode" 0)
  (DL_MakeLayer "PP-DX-PT")
  (setq lay_nam (getvar "CLAYER"))
  (setvar "CLAYER" "PP-DX-PT")
  (if tkmb
    (progn ;;如果是已知属性块
	   (setq str_tkm  (caar tkmb)
		 tmp_tkmb (cdr tkmb)
	   )
	   (if tmp_tkmb
	     (progn
	       (foreach	str_tmp	tmp_tkmb
		 (setq str_tkm (strcat str_tkm "," (car str_tmp)))
	       )
	     )
	   )
	   (setq glb (list '(0 . "INSERT") '(66 . 1) (cons 2 str_tkm)))
	   (prompt "\n 选择要转换图块：")
	   (setq ss (ssget glb))
	   (if ss
	     (progn
	       (HY_UndoM)
	       (szz_sxbg_zdzh ss tkmb)
	     )
	   )
    )
    (progn ;;如果是未知属性块
	   (setq xh t)
	   (while xh
	     (setq enb2	(gpsseld '((0 . "INSERT") (66 . 1))
				 "\n 回车退出 / 选择任意一个标高块："
				 nil
			)
	     )
	     (if (= enb2 nil)
	       (setq xh nil)
	       (progn
		 (setq ent2 (car enb2)
		       tkm  (strcase (cdr (assoc 2 (entget ent2))))
		 )
		 (setq glb (list '(0 . "INSERT") (cons 2 tkm) '(66 . 1)))
		 (setq ns_sx  (szz_tqns_sxbg ent2)
		       ns_pos 1
		 )
		 (if (> (length ns_sx) 1)
		   (progn
		     (setq xh2 t)
		     (while xh2
		       (initget 1)
		       (setq bg_tmp (getreal "\n 输入该点标高:"))
		       (setq bz_srz nil)
		       (foreach	real_tmp ns_sx
			 (if (equal (cadr real_tmp) bg_tmp 0.0001)
			   (setq bz_srz (car real_tmp))
			 )
		       )
		       (if bz_srz
			 (setq xh2    nil
			       ns_pos bz_srz
			 )
			 (prompt "\n 输入标高不正确，重输！")
		       )
		     )
		   )
		 )
		 (setq tkmb (list (list tkm ns_pos)))
		 (prompt "\n 选择其它标高块：")
		 (setq ss (ssget glb))
		 (if (= ss nil)
		   (setq ss (ssadd))
		 )
		 (ssadd ent2 ss)
		 (szz_sxbg_zdzh ss tkmb)
	       )
	     )				;end of if enb2
	   )				;end of while xh
    )
  )					;end of if tkmb
  (setvar "CLAYER" lay_nam)
  (setvar "cmdecho" 1)
  (setvar "blipmode" 1)
  (princ)
)					;end of defun
					;
					;
(defun szz_sxbg_zdzh (ss	tkmb	  /	    ns	      ns1
		      ent2	wb	  p01	    txt_bg    wbg_txttkm
		      wb_num_sx	ent_tmpnum_sx	    tkm_tmp   tkm
		     )
  (HY_set0)
  (styrem)
  (setq	ns	(sslength ss)
	ns1	0
	wbg_txt	1.0
  )
  (repeat ns
    (setq ent2 (ssname ss ns1)
	  wb   (entget ent2)
	  p01  (cdr (assoc 10 wb))
	  tkm  (strcase (cdr (assoc 2 wb)))
    )
    ;;(("7006" 1) ("7024" 1) ("7023" 1 2) ("0008" 3))
    (foreach biao tkmb
      (setq tkm_tmp   (car biao)
	    wb_num_sx (cdr biao)
      )
      (if (= tkm_tmp tkm)
	(progn
	  (foreach num_sx wb_num_sx
	    (setq ent_tmp ent2)
	    (repeat num_sx
	      (setq ent_tmp (entnext ent_tmp))
	    )
	    (setq txt_bg (scanb (cdr (assoc 1 (entget ent_tmp)))))
	    (if	(and (/= txt_bg "") (/= txt_bg nil))
	      (progn
		(command
		  "insert"
		  (strcat (HY_GetInstallDir) "Commres\\block\\g_donut")
		  p01
		  0.5
		  0.5
		  0.0
		)
		(command "point"
			 (list (car p01) (cadr p01) (atof txt_bg))
		)
		(HY_KZSJXZ (entlast) "ZRBG" 1040 (atof txt_bg))
		(command "text"
			 "J"
			 "ML"
			 (polar p01 0 0.75)
			 wbg_txt
			 0.0
			 txt_bg
		)
	      )
	    )
	  )
	)
      )
    )
    (setq ns1 (+ ns1 1))
  )
  (HY_RV)
)					;end of defun
					;
					;
(defun szz_tqns_sxbg (ent2 / xh sxb_tk ns1 wb enlx strtmpstr_st)
  (setq	xh t
	sxb_tk nil
	ns1 1
  )
  (while xh
    (setq ent2 (entnext ent2)
	  wb   (entget ent2)
	  enlx (cdr (assoc 0 wb))
    )
    (cond
      ((= enlx "SEQEND") (setq xh nil))
      ((/= enlx "ATTRIB") t)
      ((= enlx "ATTRIB")
       (setq strtmp (scanb (cdr (assoc 1 wb))))
       (if (= strtmp "")
	 (setq sxb_tk (cons (list ns1 nil) sxb_tk))
	 (progn
	   (setq str_st (substr strtmp 1 1))
	   (if (and (/= str_st ".")
		    (/= str_st "+")
		    (/= str_st "-")
		    (= (atof str_st) 0)
	       )
	     t
	     (setq sxb_tk (cons (list ns1 (atof strtmp)) sxb_tk))
	   )
	 )
       )
      )
    )					;end of cond
    (setq ns1 (+ ns1 1))
  )					;end of while xh
  sxb_tk
)					;end of defun
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;2003/8/28  lxf   非高程线转层
;;提取地形图上Z值为0的line pline arc spline
;;(这些实体应不在ROAD,AXIS,XROAD,ROAD-1,PP-DX-DGXZ,PP-DX-DGXS层上),
;;然后让用户输入一个层名,将符合条件的实体转到该层上.
(defun ChangePmCurveLayer
       (/ L_layer L_ss L_glb L_strParm L_oldCmd L_kword L_ent L_38 L_n L_i L_entType L_pt L_rb)
  (HY_UndoM)
  (setq L_oldCmd (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (setq	L_glb '((0 . "LINE,*POLYLINE,ARC,SPLINE")
		(-4 . "<not")
		(8 . "ROAD,AXIS,XROAD,ROAD-1,PP-DX-DGXZ,PP-DX-DGXS")
		(-4 . "not>")
		(-4 . "<and")
				(-4 . "*,*,<")
				(10 0.0 0.0 1.0e-20)
				(-4 . "*,*,>")
				(10 0.0 0.0 -1.0e-20)
				(-4 . "*,*,<")
				(11 0.0 0.0 1.0e-20)
				(-4 . "*,*,>")
				(11 0.0 0.0 -1.0e-20)
		(-4 . "and>")
	       )
  )
  (initget "W")
  (setq L_kword (getkword "\n窗选 W /<全图>: "))
  (if (or (= L_kword "w") (= L_kword "W"))
    (progn
      (setq L_ss (ssget L_glb))
    )
    (setq L_ss (ssget "X" L_glb))
  )
 (if L_ss
  	(progn
	  	(setq L_n (sslength L_ss)
	  		L_i (1- L_n)
	  	)
		(repeat L_n
			(setq L_ent (ssname L_ss L_i))
			(setq L_rb (entget L_ent))
			(setq L_entType (cdr (assoc 0 L_rb)))
			(if (= L_entType "SPLINE")
				(progn 
					(setq L_pt (assoc 10 L_rb))
					(setq L_pt (cadddr L_pt))
					(if (and L_pt (or (> L_pt 1.0e-20) (< L_pt -1.0e-20)) )
						(ssdel L_ent L_ss)
					)
				)
				(progn 
					(setq L_38 (assoc 38 L_rb))
					(setq L_38 (cdr L_38))
					(if (and (/= L_38 nil) (or (> L_38 1.0e-20) (< L_38 -1.0e-20)))
						(ssdel L_ent L_ss)
					)					
				)				
			)
			(setq L_i (1- L_i))
		)
	)
)

  (if (and L_ss (> (sslength L_ss) 0))
    (progn
    	(setq L_layer "")
      (setq L_layer (getstring "\n回车退出 / 输入要转到的层名:"))
      (if(/= L_layer "")
	    (progn
	      (if (null (tblsearch "LAYER" L_layer))
		(command "layer" "M" L_layer "")
	      )
	      (command ".change" L_ss "" "p" "la" L_layer "")
	      (setq L_strParm (strcat "\n成功转了"
				      (itoa (sslength L_ss))
				      "个实体(可以用Undo回退)!!!"
			      )
	      )
	    )
      )
    )
    (setq L_strParm "\n没有什么实体可以转!!!")
  )
  (setvar "cmdecho" L_oldCmd)
  (if L_strParm
 	 (princ L_strParm)
  )
)

(defun viewss (ss / text len count pt minpt maxpt flag ptlist ucspt)
	
	(setq flag t)
	(setq len (sslength ss))
	(setq count 0)
	;;(setq ucspt (getvar "UCSORG"))
;;	(princ (list "\n ucspt" ucspt))
	(repeat len
		(setq ent	(ssname  ss count))
		(setq ent (entget ent))
		(setq count (1+ count))
		(if (and (= "TEXT" (strcase (cdr (assoc 0 ent)))) (HY_isNum (cdr (assoc 1 ent))))
			(progn
				(setq pt (cdr (assoc 10 ent)))
				(if flag
					(progn
						(setq flag nil)
						(setq minpt pt)
						(setq maxpt pt)
						
					)
					(progn
						(setq maxpt (list (max (car pt) (car maxpt)) (max (cadr pt) (cadr maxpt)) 0))
						(setq minpt (list (min (car pt) (car minpt)) (min (cadr pt) (cadr minpt)) 0))
					)
				)
				
			)
		)
		
	)
	(setq minpt (list (- (car minpt) 50) (- (cadr minpt) 50) 0))
	(setq maxpt (list (+ (car maxpt) 50) (+ (cadr maxpt) 50) 0))
	(command "zoom"  "w"  minpt  maxpt )
	;;(&view_ptb (list minpt maxpt))
)

(defun get_dgxbg_builtin(ent / wb pt bg_dgx   )
 (setq wb (entget ent) )
 (setq pt (cdr (assoc 10 wb)) )
 (if (= pt nil) (progn
   (setq pt (cdr (assoc 11 wb)) )
 ))
 (setq bg_dgx (caddr pt) )
 (if (= bg_dgx nil) (progn    ;;如果是LWPOLYLINE，等高线的标高在38项里面，这时候的10为二维点
   (setq bg_dgx (cdr (assoc 38 wb)) )
 ))
 bg_dgx
)
;;;计算任意方向观察的上和右方向角
(defun &hy_jxjhs(anjx / anjs anzx )
 (setq anjx (rem anjx (* pi 2.0)) )
 (if (< anjx 0.0) (setq anjx (+ anjx (* pi 2.0))) )
 (if (> anjx pi) (setq anjx (- anjx pi)) )
 (if (<= anjx (* pi 0.5))
   (setq anjs (+ anjx (* pi 0.5)) anzx anjx)
   (setq anjs (- anjx (* pi 0.5)) anzx (+ anjx pi))
 )
 (list anjs anzx)
)  

;;;弧度换算为角度
(defun hudtojd(ang) (* (/ ang pi) 180.0))
