;;;加入标志杆
(defun ?dl_bz_join_bzg (/	  loop	    ent	      bzg_ent
			loop1	  dcl_id    what      bzg_sty
			bzg_ang	  sld_list  chk_dat   bz_shape
			radio	  blong	    long      width
			ang	  dis_x	    dis_y     bz_bmpfile
			blk_bmpfile	    str	      str1
			chk_rename		       )
  (HY_Set0)
;;;检查标志杆数据中已有该标志的句柄	
  (defun chk_rename (ent_jb str / flag len n str1 jb_n str2)
    (setq flag nil)
    (setq len  (strlen str)
	  n    1
	  jb_n 1
    )
    (while (and (null flag) (<= n len))
      (setq str1 (substr str n 1)
	    str2 (substr ent_jb jb_n 1)
      )
      (if (equal str1 str2)
	(progn
	  (if (= jb_n (strlen ent_jb))
	    (if	(or (= (substr str (1+ n) 1) " ")
		    (= (substr str (1+ n) 1) "")
		)
	      (setq flag t)
	      (setq jb_n 1)
	    )
	  )
	  (setq jb_n (1+ jb_n))
	)
	(setq jb_n 1)
      )
      (setq n (1+ n))
    )
    flag
;;;if falg=t 已有
  )

;;;由图块名获得相应的bmp文件，不检查文件是否存在。
;;;在系统中，新建一个bmp目录，以存放bmp文件
  (defun blk_bmpfile (blkname / bmpfile loop str str1 ff)
    (setq bmpfile "")
    (if	(setq ff (open (strcat (HY_GetInstallDir) "user\\bz_bmp.txt") "r"))
      (progn
	(setq loop t)
	(while (and loop (setq str (read-line ff)))
	  (setq str1 (substr str 1 6))
	  (if (equal (strcase str1) (strcase blkname))
	    (progn
	      (setq str1 (strtrim (substr str 8 (- (strlen str) 7))))
	      (if
		(and (> (strlen str1) 4)
		     (equal (strcase (substr str1 (- (strlen str1) 3) 4))
			    ".BMP"
		     )
		)
		 (setq loop nil)
		 (setq bmpfile (strcat (substr str 8 (- (strlen str) 7))
				       ".bmp"
			       )
		       loop    nil
		 )
	      )
	    )
	  )
	)
	(close ff)
      )
    )
    bmpfile
  )

;;;数据检查函数	
  (defun chk_dat (/ flag)
    (setq flag t)
    (if	(null "?add_zero")
      (#ppls "dljtbz")
    )
    (setq radio	(?add_zero (get_tile "radio"))
	  blong	(?add_zero (get_tile "blong"))
	  long	(?add_zero (get_tile "long"))
	  width	(?add_zero (get_tile "width"))
	  ang	(?add_zero (get_tile "ang"))
	  dis_x	(?add_zero (get_tile "dis_x"))
	  dis_y	(?add_zero (get_tile "dis_y"))
    )
    (cond
      ((and (= bz_shape 1) (chknum 0 radio))
       (set_tile "error" "圆直径必须为大于0的数!")
       (setq flag nil)
      )
      ((and (= bz_shape 2) (chknum 0 blong))
       (set_tile "error" "三角形边长必须为大于0的数!")
       (setq flag nil)
      )
      ((and (= bz_shape 3) (chknum 0 long))
       (set_tile "error" "矩形的长必须为大于0的数!")
       (setq flag nil)
      )
      ((and (= bz_shape 3) (chknum 0 width))
       (set_tile "error" "矩形的高必须为大于0的数!")
       (setq flag nil)
      )
      ((chknum nil dis_x)
       (set_tile "error" "距基点X方向距离必须为数!")
       (setq flag nil)
      )
      ((chknum nil dis_y)
       (set_tile "error" "距基点Y方向距离必须为数!")
       (setq flag nil)
      )
    )
    flag
  )


;;;红绿灯数据检查函数	
  (defun chk_dat1 (/ flag)
    (setq flag t)
    (if	(null "?add_zero")
      (#ppls "dljtbz")
    )
    (setq dis_x	(?add_zero (get_tile "dis_x"))
	  dis_y	(?add_zero (get_tile "dis_y"))
    )
    (cond
      ((chknum nil dis_x)
       (set_tile "error" "距基点X方向距离必须为数!")
       (setq flag nil)
      )
      ((chknum nil dis_y)
       (set_tile "error" "距基点Y方向距离必须为数!")
       (setq flag nil)
      )
    )
    flag
  )


  (setq loop t)
  (while loop
    (setq bzg_ent (HY_SelSingleEnt "\n回车退出 /请选择标志杆:"
			   "INSERT"
			   "pp-dl-bzg"
			   "dlbz_bzg"
			   nil
		  )
    )
    (cond
      ((null bzg_ent) (setq loop nil))
      ((= bzg_ent "RETURN")
       (princ "\n没有选中交通标志!")
      )
      (t
       (setq bzg_ent  (car bzg_ent)
	     bzg_sty  (HY_QQ10xx bzg_ent "dlbz_bzg" 1070)
	     bzg_ang  (HY_QQ10xx bzg_ent "dlbz_bzg" 1040)
	     sld_list '("jt_adbz1" "jt_adbz2" "jt_adbz3")
	     loop     nil
	     loop1    t
       )

       (while loop1
	 (setq
	   ent (HY_SelSingleEnt
		 "\n回车退出 /请选择交通标志:"
		 "INSERT"
		 "PP-DL-JTBZ"
		 nil
		 nil
	       )
	 )
	 
	 (cond
	   ((null ent) (setq loop1 nil))
	   ((= ent "RETURN")
	    (princ "\n没有选中交通标志!")
	   )
	   (t
	    (setq ent (car ent))

	    (if
;;;红绿灯													
	      (equal
		(strcase (strcase(cdr (assoc 2 (entget ent)))))
		"RYB_LAMP"
	      )
	       (progn
		 (setq
		   dcl_id (load_dialog
			    (strcat (HY_GetInstallDir)
				    "Commres\\DCL\\@@bzxs.dcl"
			    )
			  )
		 )
		 (if
		   (not
		     (new_dialog "jt_bz_addbz1" dcl_id)
		   )
		    (exit)
		 )
		 (playsld (nth (1- bzg_sty) sld_list)
			  "sty1"
		 )
		 (setq bz_shape 11)
		 (if (appft ent "dlbz_bz")
		   (progn
		     (setq bz_shape (HY_QQ10xx ent
					    "dlbz_bz"
					    1070
				    )
			   dis_x    (car (HY_QQ10xx ent
						 "dlbz_bz"
						 1010
					 )
				    )
			   dis_y    (cadr (HY_QQ10xx ent
						  "dlbz_bz"
						  1010
					  )
				    )
		     )
		     (set_tile "dis_x"
			       (rtos dis_x 2 2)
		     )
		     (set_tile "dis_y"
			       (rtos dis_y 2 2)
		     )
		     (if (= bz_shape 11)
		       (set_tile "bz_shape" "low")
		     )
		     (if (= bz_shape 12)
		       (set_tile "bz_shape" "mid")
		     )
		     (if (= bz_shape 13)
		       (set_tile "bz_shape" "high")
		     )
		   )
		 )

		 (action_tile
		   "low"
		   "(setq bz_shape 11)"
		 )
		 (action_tile
		   "mid"
		   "(setq bz_shape 12)"
		 )
		 (action_tile
		   "high"
		   "(setq bz_shape 13)"
		 )
		 (action_tile
		   "accept"
		   "(if (chk_dat1)(done_dialog 1))"
		 )
		 (action_tile
		   "cancel"
		   "(done_dialog 0)"
		 )
		 (setq what (start_dialog))
		 (if (= what 1)
		   (progn
		     (setq dis_x      (read dis_x)
			   dis_y      (read dis_y)
			   bz_bmpfile "red.bmp"
		     )
		     (HY_KZSJXZ ent
			     "dlbz_bz"
			     1000
			     bz_bmpfile
			     1010
			     (list dis_x dis_y 0)
			     1070
			     bz_shape
		     )
		     (setq str (HY_QQ10xx bzg_ent
				       "dlbz_bzg"
				       1000
			       )
		     )
		     (if (null str)
		       (setq str "")
		     )
		     (if
		       (null
			 (chk_rename
			   (cdr (assoc 5 (entget ent)))
			   str
			 )
		       )
			(progn
			  (if (= str "")
			    (setq
			      str
			       (strcat
				 str
				 (cdr
				   (assoc 5
					  (entget ent)
				   )
				 )
			       )
			    )
			    (setq
			      str
			       (strcat
				 str
				 " "
				 (cdr
				   (assoc 5
					  (entget ent)
				   )
				 )
			       )
			    )
			  )
			  (HY_KZSJXZ bzg_ent
				  "dlbz_bzg"
				  1000
				  str
			  )
			)
		     )
		   )
		 )
		 (unload_dialog dcl_id)
	       )
;;;一般标志							
	       (progn

		 (setq
		   dcl_id (load_dialog
			    (strcat (HY_GetInstallDir)
				    "Commres\\DCL\\@@bzxs.dcl"
			    )
			  )
		 )
		 (if
		   (not
		     (new_dialog "jt_bz_addbz" dcl_id)
		   )
		    (exit)
		 )
		 
		 (playsld (nth (1- bzg_sty) sld_list)
			  "sty1"
		 )
		 
		
		 (if (appft ent "dlbz_bz")
		   (progn
		     
		     (setq bz_shape (HY_QQ10xx ent
					    "dlbz_bz"
					    1070
				    )
			   radio    (HY_QQ10xx ent
					    "dlbz_bz"
					    1041
				    )
			   blong    (HY_QQ10xx ent
					    "dlbz_bz"
					    1041
				    )
			   long	    (HY_QQ10xx ent "dlbz_bz" 1041)
			   width    (caddr (HY_QQ10xx ent
						   "dlbz_bz"
						   1010
					   )
				    )
			   ang	    (HY_QQ10xx ent "dlbz_bz" 1040)
			   dis_x    (car (HY_QQ10xx ent
						 "dlbz_bz"
						 1010
					 )
				    )
			   dis_y    (cadr (HY_QQ10xx ent
						  "dlbz_bz"
						  1010
					  )
				    )
		     )

		     (set_tile "radio"
			       (rtos radio 2 2)
		     )
		     (set_tile "blong"
			       (rtos blong 2 2)
		     )
		     (set_tile "long" (rtos blong 2 2))
		     (set_tile "width"
			       (rtos width 2 2)
		     )
		     (set_tile "ang" (rtos ang 2 2))
		     (set_tile "dis_x"
			       (rtos dis_x 2 2)
		     )
		     (set_tile "dis_y"
			       (rtos dis_y 2 2)
		     )
		     (if (= bz_shape 1)
		       (set_tile "bz_shape" "low")
		     )
		     (if (= bz_shape 2)
		       (set_tile "bz_shape" "mid")
		     )
		     (if (= bz_shape 3)
		       (set_tile "bz_shape" "high")
		     )
		   )
		   (setq bz_shape 1)
		 )

		 (cond
;;;	圆						
		   ((= bz_shape 1)
		    (mode_tile "radio" 0)
		    (mode_tile "blong" 1)
		    (mode_tile "long" 1)
		    (mode_tile "width" 1)
		   )
;;;	三角				
		   ((= bz_shape 2)
		    (mode_tile "radio" 1)
		    (mode_tile "blong" 0)
		    (mode_tile "long" 1)
		    (mode_tile "width" 1)
		   )
;;;	矩形						
		   ((= bz_shape 2)
		    (mode_tile "radio" 1)
		    (mode_tile "blong" 1)
		    (mode_tile "long" 0)
		    (mode_tile "width" 0)
		   )
		 )
		 (action_tile
		   "low"
		   "(setq bz_shape 1)(mode_tile \"radio\" 0)(mode_tile \"blong\" 1)(mode_tile \"long\" 1)(mode_tile \"width\" 1)"
		 )
		 (action_tile
		   "mid"
		   "(setq bz_shape 2)(mode_tile \"radio\" 1)(mode_tile \"blong\" 0)(mode_tile \"long\" 1)(mode_tile \"width\" 1)"
		 )
		 (action_tile
		   "high"
		   "(setq bz_shape 3)(mode_tile \"radio\" 1)(mode_tile \"blong\" 1)(mode_tile \"long\" 0)(mode_tile \"width\" 0)"
		 )
		 (action_tile
		   "accept"
		   "(if (chk_dat)(done_dialog 1))"
		 )
		 (action_tile
		   "cancel"
		   "(done_dialog 0)"
		 )
		 (setq what (start_dialog))
		 (if (= what 1)
		   (progn
		     (setq radio (read radio)
			   blong (read blong)
			   long	 (read long)
			   width (read width)
			   ang	 (read ang)
			   dis_x (read dis_x)
			   dis_y (read dis_y)
		     )
		     (setq bz_bmpfile
			    (blk_bmpfile
			      (strcase(cdr (assoc 2 (entget ent))))
			    )
		     )
		     (cond
;;;圆									
		       ((= bz_shape 1)
			(HY_KZSJXZ	ent
				"dlbz_bz"
				1000
				bz_bmpfile
				1010
				(list dis_x dis_y 0)
				1040
				ang
				1041
				radio
				1070
				bz_shape
			)
		       )
;;;三角									
		       ((= bz_shape 2)
			(HY_KZSJXZ	ent
				"dlbz_bz"
				1000
				bz_bmpfile
				1010
				(list dis_x dis_y 0)
				1040
				ang
				1041
				blong
				1070
				bz_shape
			)
		       )
;;;矩形									
		       ((= bz_shape 3)
			(HY_KZSJXZ	ent
				"dlbz_bz"
				1000
				bz_bmpfile
				1010
				(list dis_x dis_y width)
				1040
				ang
				1041
				long
				1070
				bz_shape
			)
		       )
		     )

		     (setq str (HY_QQ10xx bzg_ent
				       "dlbz_bzg"
				       1000
			       )
		     )
		     (if (null str)
		       (setq str "")
		     )
		     (if
		       (null
			 (chk_rename
			   (cdr (assoc 5 (entget ent)))
			   str
			 )
		       )
			(progn
			  (if (= str "")
			    (setq
			      str
			       (strcat
				 str
				 (cdr
				   (assoc 5
					  (entget ent)
				   )
				 )
			       )
			    )
			    (setq
			      str
			       (strcat
				 str
				 " "
				 (cdr
				   (assoc 5
					  (entget ent)
				   )
				 )
			       )
			    )
			  )
			  (HY_KZSJXZ bzg_ent
				  "dlbz_bzg"
				  1000
				  str
			  )
			)
		     )
		   )
		 )
		 (unload_dialog dcl_id)
	       )
	    )
	   )
	 )
       )
      )
    )
  )

  (HY_Set1)
  (princ)
)


;;;浏览标志杆
(defun ?dl_bz_ll_bzg (/	bzg_ent	   loop	      pt	 pt1
			pt2	   pt3	      pt4	 str
			bzg_high   bzg_l1     bzg_l2	 bzg_sty
			bz_disx	   bz_disy    bz_scale	 bz_entb
			n	   str1	      str2	 ent
			?dl_my_gzdlbj_offtc   ?dl_my_gzdlbj_ontc
			val1	   fent	      per_ss	 xx
		       )

 ;;; (setq w_osmode (getvar "osmode"))
  (HY_Set0)
  (defun my_err	(msg)
    (?dl_my_gzdlbj_ontc)
    (if	(and fent (entget fent))
      (progn
	(setq pre_ss (get_last fent)
	      fent   nil
	)
	(if pre_ss
	  (command ".erase" pre_ss "")
	)
      )
    )
    (HY_Set1)
  )

  (defun ?getlay_sub1 (patt / b1 lay1 layb fftt fhb)
    (setq b1 (tblnext "LAYER" t))	;***** goto the first LAYER ***** 
    (setq lay1 (strcase(cdr (assoc 2 b1))))
    (setq layb (list lay1))
    (setq fftt t)
    (while fftt
      (setq b1 (tblnext "LAYER"))
      (if (= b1 nil)
	(progn
	  (setq fftt nil)
	  (tblnext "layer" t)		;***** goto the first LAYER ***** 
	)
	(progn
	  (setq lay1 (strcase(cdr (assoc 2 b1))))
	  (setq layb (append (list lay1) layb))
	)
      )
    )
    (setq fhb nil)
    (foreach lay1 layb
      (if (wcmatch lay1 patt)
	(setq fhb (append (list lay1) fhb))
      )
    )
    fhb
  )

;;;关闭图层	
  (defun ?dl_my_gzdlbj_offtc (/ fhb layb lay flag)
    (setq flag "off"
	  fhb  '("PP-TMP-SELDL" "PP-COM")
    )
    (setq layb (?getlay_sub1 "*"))
    (command "layer")
    (foreach lay layb
      (if (member lay fhb)
	(princ)
	(command flag lay)
      )
    )
    (command "")
  )
;;;恢复图层	
  (defun ?dl_my_gzdlbj_ontc (/ flag fhb lay)
    (setq flag "on")
    (setq fhb (?getlay_sub1 "*"))
    (command "layer")
    (foreach lay fhb
      (command flag lay)
    )
    (command "")
    (princ)
  )
  
  (pusherr my_err)

;;  (setq	olderr	*error*
;;	*error*	my_err
;;  )
  (setq loop t)
  (while loop
    (setq bzg_ent (HY_SelSingleEnt "\n回车退出 /请选择要浏览的标志杆:"
			   "INSERT"
			   "pp-dl-bzg"
			   "dlbz_bzg"
			   nil
		  )
    )
    (cond
      ((null bzg_ent) (setq loop nil))
      ((= bzg_ent "RETURN")
       (princ "\n没有选中交通标志!")
      )
      (t
       (setq bzg_ent (car bzg_ent))
       (if (null (tblsearch "layer" "pp-tmp-seldl"))
	 (command ".layer" "n" "pp-tmp-seldl" "s" "pp-tmp-seldl" "")
	 (command ".layer" "s" "pp-tmp-seldl" "")
       )

       (setq bzg_high (caddr (HY_QQ10xx bzg_ent "dlbz_bzg" 1010))
	     bzg_l1   (car (HY_QQ10xx bzg_ent "dlbz_bzg" 1010))
	     bzg_l2   (cadr (HY_QQ10xx bzg_ent "dlbz_bzg" 1010))
	     str      (HY_QQ10xx bzg_ent "dlbz_bzg" 1000)
       )
       (if (and str (/= (setq str (strtrim str)) ""))
	 (progn
	   (setq n 1
		 str2 ""
		 bz_entb nil
	   )
	   (repeat (1+ (strlen str))
	     (setq str1 (substr str n 1))
	     (if (or (= str1 " ") (= str1 ""))
	       (progn
		 (if (/= (strtrim str2) "")
		   (setq bz_entb (cons (strtrim str2) bz_entb))
		 )
		 (setq str2 "")
	       )
	       (setq str2 (strcat str2 str1))
	     )
	     (setq n (1+ n))
	   )
	   (if bz_entb
	     (progn
	       (initget 1)
	       (setq pt (getpoint "\n请点取预览标志的放置点:"))

	       (setq bz_scale 10)
	       (setq val1     (HY_QQ10xx bzg_ent "dlbz_bzg" 1010)
		     bzg_l1   (car val1)
		     bzg_l2   (cadr val1)
		     bzg_high (caddr val1)
		     bzg_sty  (HY_QQ10xx bzg_ent "dlbz_bzg" 1070)
	       )
	       (HY_SV)
	       (command ".view" "s" "aaa")
	       (setq fent (ent_last))

;;;draw bzg							 
	       (cond
		 ((= bzg_sty 1)
		  (command ".line"
			   pt
			   (polar pt 0 (* bz_scale bzg_l1))
			   ""
		  )
		  (command ".line"
			   pt
			   (polar pt (* pi 1.5) (* bz_scale bzg_high))
			   ""
		  )
		 )
		 ((= bzg_sty 2)
		  (command ".line"
			   pt
			   (polar pt 0 (* bz_scale bzg_l1))
			   ""
		  )
		  (command ".line"
			   pt
			   (polar pt (* pi 1.5) (* bz_scale bzg_high))
			   ""
		  )
		  (command ".line"
			   (polar pt 0 (* bz_scale bzg_l1))
			   (polar (polar pt 0 (* bz_scale bzg_l1))
				  (* pi 1.5)
				  (* bz_scale bzg_high)
			   )
			   ""
		  )
		 )
		 ((= bzg_sty 3)
		  (command ".line"
			   pt
			   (polar pt 0 (* bz_scale bzg_l1))
			   ""
		  )
		  (command ".line"
			   pt
			   (polar pt pi (* bz_scale bzg_l2))
			   ""
		  )
		  (command ".line"
			   pt
			   (polar pt (* pi 1.5) (* bz_scale bzg_high))
			   ""
		  )
		 )
	       )
	       (foreach	xx bz_entb
		 (setq ent (handent xx))
		 (if (and ent (entget ent))
		   (progn
		     (setq bz_disx (car (HY_QQ10xx ent "dlbz_bz" 1010))
			   bz_disy (cadr (HY_QQ10xx ent "dlbz_bz" 1010))
		     )
		     (command ".copy"
			      ent
			      ""
			      (cdr (assoc 10 (entget ent)))
			      (list (+ (car pt) (* bz_scale bz_disx))
				    (- (cadr pt) (* bz_scale bz_disy))
				    0
			      )
		     )


		     (if
		       (equal (strcase(cdr (assoc 2 (entget ent)))) "RYB_LAMP")
			(progn
			  (HY_KZSJXZ (entlast)
				  nil
				  41
				  2.5
				  42
				  2.5
				  43
				  2.5
				  8
				  "pp-tmp-seldl"
				  50
				  0
			  )
			  (cond
			    ((=	2
				(- (HY_QQ10xx (entlast) "DLBZ_BZ" 1070) 10)
			     )
			     (command ".rotate"
				      (entlast)
				      ""
				      (cdr (assoc 10 (entget (entlast))))
				      90
			     )
			    )
			    ((=	3
				(- (HY_QQ10xx (entlast) "DLBZ_BZ" 1070) 10)
			     )
			     (command ".rotate"
				      (entlast)
				      ""
				      (cdr (assoc 10 (entget (entlast))))
				      270
			     )
			    )
			  )

			)
			(HY_KZSJXZ	(entlast)
				nil
				41
				0.25
				42
				0.25
				43
				0.25
				8
				"pp-tmp-seldl"
				50
				0
			)
		     )

		   )
		 )
	       )

	       (?dl_my_gzdlbj_offtc)
	       (pan2v pt)
	       (getpoint "\n 回车返回")
	       (?dl_my_gzdlbj_ontc)
	       (setq pre_ss (get_last fent)
		     fent   nil
	       )
	       (if pre_ss
		 (command ".erase" pre_ss "")
	       )
	       (command ".view" "r" "aaa")
	       (HY_RV)
	     )
	   )
	 )
	 (princ "\n 该标志杆上没有连接标志!")
       )
      )
    )
  )

;;;  (setq *error* olderr)
  (HY_Set1)
  (clr_err)
;;;  (setq *error* error)
;;;  (setvar "osmode" w_osmode)
  (princ)
)

(princ)
