;;;modi 1998.04.20
;;;modi yft 99.12.24
(defun &dljdbh (/			sca		xh		pt		bh		xh2		pt2		ss		ent
								wb		sx1		ns		ns1		bht		str		xwg		zjz		num
								pa		pb		an1		an2		bzh		r_cir	dan		laydh	uctr
								hhqxjdbh laynam_jdbz laynam_zxx
							 )
	(#ppls "@T_TFWG")
	(HY_Set0)
;;;
	;;(setq laynam_zxx (c_pps_chglay "HY_DL_AXIS_LAYER" "laysym" "laynam"))
	(setq laynam_zxx "Axis")
	;;(setq	laydh (c_pps_chglay "HY_DL_DHBZ_LAYER" "laysym" "laynam")) 	;"PP-DL-DHBZ"
	(setq	laydh  "ROAD-TEXT")
	;;(setq		uctr	(u_ctrl)	)
	(HY_UndoM)
;;;6:22 PM 11/23/98
	;;(mk_ly laydh)
	(DL_MakeLayer laydh)
;	(mk_ly "PP-DL-JD")
  ;;(setq laynam_jdbz (c_pps_chglay "HY_DL_JD_LAYER" "laysym" "laynam"))
  (setq laynam_jdbz "HY_DL_JD")
	;;(mk_ly laynam_jdbz)
	(DL_MakeLayer laynam_jdbz)
	(setq	sca		(dl_getdrawingFactor);;(dw-sc)
				xh		t
				bht		""
				num		nil
				xwg		(/ (Dl_GetTextHeight) sca)
				r_cir	(/ 4.5 sca)
	)
	(setq ss (ssget "X" '((2 . "DLGYCS") (-3 ("DLGYCS")))))
	(if	ss
		(progn
			(setq	ent	(ssname ss 0)
						wb	(entget ent '("DLBZCS"))
			)
			(if	(assoc -3 wb)
				(setq bzh (cdr (assoc 1070 (cdadr (assoc -3 wb)))))
			)
		)
	)
	(if	(= bzh nil)
		(setq bzh (&rjdwr bzh "r"))
	)
	(while xh
		(hy_sv)
		(setvar "osmode" 512)
		(initget "Z H G")
		(setq	pt
					 (getpoint
						 "\n>>回车返回 / 改标注形式 G / 弧交点编号 H / 交点自动编号 Z / <请点取道路控制点>:"
					 )
		)
																				;(setvar "osmode" 0)
		(hy_rv)
		(cond
			((= pt nil) (setq xh nil))
			((= pt "G")
			 (setq bzh (&rjdwr bzh "r"))
			)
			((= pt "H")
			 (setq xh2 t)
			 (while	xh2
				 ;;(setq ent (mentsel	"\n>>空选或回车返回 / <选择道路中线弧>:"	"ARC"		laynam_zxx	"PP-AXIS"		"U" )		 )
				 (setq ent (gpsseld	 (list (cons 0 "ARC") (cons 8 laynam_zxx))  "\n>>空选或回车返回 / <选择道路中线弧>:"	"U" )		 )

				 (cond
					 ((= ent nil) (setq xh2 nil))
					 ((= ent "RETURN") (prompt "\n没选中道路中线弧!"))
					 ((= ent "U") (HY_UndoB));;($undo_b uctr))
					 (t
						(hy_sv)
						(setq	enth (car ent)
									wb	 (entget enth '("DWAPP"))
									enlx (cdr (assoc 0 wb))
						)
						(cond
;;;							((and (wcmatch enlx "*POLYLINE") (appft enth "HHQX"))
;;;							 (hhqxjdbh enth)
;;;							)
							((= enlx "ARC")
							 (setq pt2 (cdr (assoc 10 wb))
										 an1 (cdr (assoc 50 wb))
										 an2 (cdr (assoc 51 wb))
										 zjz (cdr (assoc 40 wb))
							 )
							 (setq dan (- an2 an1))
							 (if (< dan 0.0)
								 (setq dan (+ dan (* pi 2.0)))
							 )
							 (if (>= dan pi)
								 (prompt "\n弧大于半圆,找不到外切线交点.")
								 (progn
									 (setq bh (&sljdbh nil))
									 (setq pa	(polar pt2 an1 zjz)
												 pb	(polar pt2 an2 zjz)
									 )
									 (setq
										 pt2 (interss	pa
																	(polar pa (+ an1 (* pi 0.5)) 1026.0)
																	pb
																	(polar pb (- an2 (* pi 0.5)) 1026.0)
																	nil
												 )
									 )
									 (if (pdqpmd pt2)
										 (progn
											 (setq wb	 (qdqpmd)
														 pld (car wb)
														 pru (cadr wb)
											 )
											 (setq pld (list (- (min (car pld) (car pt2)) 10.0)
																			 (- (min (cadr pld) (cadr pt2)) 10.0)
																			 0.0
																 )
														 pru (list (+ (max (car pru) (car pt2)) 10.0)
																			 (+ (max (cadr pru) (cadr pt2)) 10.0)
																			 0.0
																 )
											 )
											 (command "zoom" "w" pld pru)
										 )
									 )
									 (hy_rv)
									 (initget 1)
									 (setq pt (getpoint pt2 "\n>>输入标注位置:"))
									 (hy_sv)
									 (setq ss
													(ssget
														"C"
														(polar pt2 (* 0.25 pi) (/ 2.0 sca))
														(polar pt2 (* 1.25 pi) (/ 2.0 sca))
														'((-3 ("RJCDBH")) (0 . "INSERT") (2 . "DLSZ"))
													)
									 )
									 (if ss
										 (progn
											 (setq ent (ssname ss 0))
											 (HY_KZSJXZ ent "RJCDBH" 1000 bh)
										 )
										 (progn
											 ;;(command	"insert"	(strcat (ppswl) "dwg/dlsz")	pt2	(/ 1.0 sca)	 ""		0.0							 )
											 (szdl_ins_sysblk "dlsz" pt2 (/ 1.0 sca) (/ 1.0 sca) 0.0)
											 (setq ent (entlast))
											 (HY_KZSJXZ (entlast) "RJCDBH" 1000 bh)
											 (command "line" pa pt2 "")
											 (command "line" pb pt2 "")
										 )
									 )
									 (&rjdbhbz pt2 pt bzh bh xwg ent)
									 (if (= (type (read (substr bh (strlen bh)))) 'INT)
										 (progn
											 (setq str ""
														 ns1 (strlen bh)
														 zjz "T"
														 num nil
											 )
											 (while	zjz
												 (if (= (type (read (substr bh ns1 1))) 'INT)
													 (progn
														 (setq ns1 (- ns1 1))
														 (if (= ns1 0)
															 (setq zjz nil)
														 )
													 )
													 (setq zjz nil)
												 )
											 )
											 (if (= ns1 0)
												 (setq bht ""
															 num (read bh)
												 )
												 (progn
													 (setq bht (substr bh 1 ns1))
													 (if (/= ns1 (strlen bh))
														 (setq num (read (substr bh (+ ns1 1))))
													 )
												 )
											 )
										 )
										 (setq bht bh
													 num nil
										 )
									 )
									 (initget "Y N")
									 (setq ss (getkword "\n>>弧参数是否标注 (Y/N)?<Y>"))
									 (setvar "clayer" laydh)
									 (setq wb (dw-dlha enth ss))
									 (HY_KZSJXZ ent "PPDLJD" 1000 (listoa wb))
									 (hy_rv)
									 (setvar "clayer" laynam_jdbz)
								 )
							 )
							)

						)
					 )
				 )
			 )																;end of while xh2
			)

			((= pt "Z")
			 (#dljdbh)
			)
			(pt
			 (setq pt (&zdlzxd2 pt))
			 (if (= pt nil)
				 (progn
					 (print)
					 (prompt "\n没选中道路中心线,重选!")
				 )
				 (progn
					 (setq pt (car pt))
					 (setq bh (&sljdbh nil))
					 (initget 1)
					 (setq pt2 (getpoint pt "\n>>输入标注位置:"))
					 (hy_sv)
					 (setq
						 ss	(ssget "C"
											 (polar pt (* 0.25 pi) (/ 1.0 sca))
											 (polar pt (* 1.25 pi) (/ 1.0 sca))
											 '((-3 ("RJCDBH")) (0 . "INSERT") (2 . "DLSZ"))
								)
					 )
					 (if ss
						 (progn
							 (setq ent (ssname ss 0))
							 (HY_KZSJXZ ent "RJCDBH" 1000 bh)
						 )
						 (progn
							 ;;(command	"insert"		(strcat (ppswl) "dwg/dlsz")	pt		(/ 1.0 sca)		""								0.0							 )
							 (szdl_ins_sysblk "dlsz" pt (/ 1.0 sca) (/ 1.0 sca) 0.0)
							 (setq ent (entlast))
							 (HY_KZSJXZ (entlast) "RJCDBH" 1000 bh)
						 )
					 )
					 (&rjdbhbz pt pt2 bzh bh xwg ent)
					 (if (= (type (read (substr bh (strlen bh)))) 'INT)
						 (progn
							 (setq str ""
										 ns1 (strlen bh)
										 zjz "T"
										 num nil
							 )
							 (while	zjz
								 (if (= (type (read (substr bh ns1 1))) 'INT)
									 (progn
										 (setq ns1 (- ns1 1))
										 (if (= ns1 0)
											 (setq zjz nil)
										 )
									 )
									 (setq zjz nil)
								 )
							 )
							 (if (= ns1 0)
								 (setq bht ""
											 num (read bh)
								 )
								 (progn
									 (setq bht (substr bh 1 ns1))
									 (if (/= ns1 (strlen bh))
										 (setq num (read (substr bh (+ ns1 1))))
									 )
								 )
							 )
						 )
						 (setq bht bh
									 num nil
						 )
					 )
					 (hy_rv)
				 )
			 )																;end of if ss
			)
		)
		(hy_rv)
	)
	(hy_set1)
	(princ)
)																				;end of defun
																				;
																				;
(defun &rjdwr	(bzh xzh / ss ent bzh2)
	(if	(= xzh "r")
		(progn
			(setq bzh2 (&xdlbzfs nil))
			(if	bzh2
				(setq bzh bzh2)
			)
		)
	)
	(setq ss (ssget "X" '((2 . "DLGYCS") (-3 ("DLGYCS")))))
	(if	ss
		(progn
			(setq ent (ssname ss 0))
			(HY_KZSJXZ ent "DLBZCS" 1070 bzh)
			(HY_KZSJXZ ent "DLGYCS" 1040 1026.0)
		)
		(progn
			;;(command "insert"				 (strcat (ppswl) "dwg/dlgycs")						 '(0.0 0.0 0.0)						 1.0				 ""				 0.0		)
			(szdl_ins_sysblk "dlgycs" '(0.0 0.0 0.0) 1.0 1.0 0.0)
			(HY_KZSJXZ (entlast) "DLBZCS" 1070 bzh)
			(HY_KZSJXZ (entlast) "DLGYCS" 1040 1026.0)
		)
	)
	bzh
)																				;end of defun
																				;
																				;
(defun &xdlbzfs	(valdef	 /			 dclnam	 sldlis	 dcltt	 tcbz
								 sldnum	 errstr	 xh			 wb			 zcuryh	 tcbz
								 x			 y
								)
	(setq	dclnam "tbxz33"
				sldlis '("dlbz1" "dlbz2" "dlbz3" "dlbz4")
				dcltt	 "选 择 标 注 方 式"
				sldnum 9
				errstr "没选择标注方式."
				tcbz	 "T"
				zcuryh 1
	)
	(setq xh t)
	(while xh
		(setq	wb (tbxsxz dclnam	sldlis zcuryh	valdef dcltt sldnum	errstr
										 tcbz)
		)
		(if	(= wb nil)
			(setq xh nil)
			(progn
				(setq	wb (cadr wb)
							xh nil
				)
			)
		)
	)
	(if	wb
		(progn
			(setq curbzh wb)
		)
	)
)																				;end of defun
																				;
																				;																				
(defun &sljdbh (ent2 / xh2 str ss ns ns1 ent wb zjz)
	(setq	xh2	t
				str	""
	)
	(while xh2
		(if	(/= bht "")
			(if	num
				(setq str (strcat bht (itoa (+ num 1))))
				(setq	num	1
							str	(strcat bht (itoa num))
				)
			)
			(if	num
				(setq str (itoa (+ num 1)))
			)
		)
		(if (or ( =  str "") (null str)) (setq str "1"))
		(setq bh (getstring (strcat "\n>>输入编号 <" str ">:")))
		(if	(= bh "")
			(setq bh str)
		)
		(setq bh (scanb bh))
		(if	(or (= bh nil) (= (read bh) nil))
			(progn
				(print)
				(prompt "\n编号不能为空,重输!")
			)
			(progn
				(setq	ss	(ssget "X" '((-3 ("RJCDBH")) (0 . "INSERT") (2 . "DLSZ")))
							zjz	nil
							bh	(strcase bh)
				)
				(if	ss
					(progn
						(setq	ns	(sslength ss)
									ns1	0
						)
						(repeat	ns
							(setq	ent	(ssname ss ns1)
										wb	(entget ent '("RJCDBH"))
							)
							(if	(and (= bh (cdr (assoc 1000 (cdadr (assoc -3 wb)))))
											 (not (equal ent ent2 0.5))
									)
								(setq zjz "T")
							)
							(setq ns1 (+ ns1 1))
						)
					)
				)
				(if	zjz
					(progn
						(print)
						(prompt "\n图中已有输入编号,重输!")
					)
					(setq xh2 nil)
				)
			)
		)
	)
	bh
)																				;end of defun
																				;
																				;																				
(defun &rjdbhbz	(pt pt2 bzh bh xwg ent / stbh wb)
	(setq stbh (cdr (assoc 5 (entget ent))))
	(cond
		((= bzh 1)
		 (command "text" "m" pt2 xwg 0.0 bh)
		 (HY_KZSJXZ (entlast) "RJDBH" 1000 stbh)
		)
		((= bzh 2)
		 (command "line" pt pt2 "")
		 (HY_KZSJXZ (entlast) "RJDBH" 1000 stbh)
		 (if (< (car pt2) (car pt))
			 (progn
				 (command
					 "text"
					 "br"
					 (polar (polar pt2 (* pi 0.5) (/ 1.0 sca)) pi (/ 1.0 sca))
					 xwg
					 0.0
					 bh
				 )
				 (setq wb	(entget (entlast))
							 pt	(cdr (assoc 10 wb))
							 pt	(polar (polar pt (* pi 1.5) (/ 1.0 sca)) pi (/ 1.0 sca))
				 )
				 (HY_KZSJXZ (entlast) "RJDBH" 1000 stbh)
			 )
			 (progn
				 (command
					 "text"
					 (polar (polar pt2 (* 0.5 pi) (/ 1.0 sca)) 0.0 (/ 1.0 sca))
					 xwg
					 0.0
					 bh
				 )
				 (HY_KZSJXZ (entlast) "RJDBH" 1000 stbh)
				 (setq wb	(textbox (entget (entlast)))
							 dl	(abs (- (caar wb) (caadr wb)))
				 )
				 (setq pt (polar pt2 0.0 (+ dl (/ 2.0 sca))))
			 )
		 )
		 (command "line" pt2 pt "")
		 (HY_KZSJXZ (entlast) "RJDBH" 1000 stbh)
		)
		((= bzh 3)
		 (command "text" "m" pt2 xwg 0.0 bh)
		 (HY_KZSJXZ (entlast) "RJDBH" 1000 stbh)
		 (command "circle" pt2 r_cir)
		 (HY_KZSJXZ (entlast) "RJDBH" 1000 stbh)
		)
		((= bzh 4)
		 (setq ang (angle pt pt2))
		 (command "line" pt pt2 "")
		 (HY_KZSJXZ (entlast) "RJDBH" 1000 stbh)
		 (setq pt (polar pt2 ang r_cir))
		 (command "circle" pt r_cir)
		 (HY_KZSJXZ (entlast) "RJDBH" 1000 stbh)
		 (command "text" "m" pt xwg 0.0 bh)
		 (HY_KZSJXZ (entlast) "RJDBH" 1000 stbh)
		)
	)
)																				;end of defun
																				;
																				;																				
(defun dw-dlha (s   key	/   sc	h   l	y   dd	s   c	c1  c2	r1  r
		p1  p2	p3  p4	dc  i	t1  ang1    ang2    d	k   k1
		kk  r2	a2  k2	t2  d2	ELAST	SS
	       )

  (hy_sv)


  (if (null dw-dlh1)
    (#ppls "Dim_pmbz")
  )
;;;11:34 AM 11/17/98  
  (setq	oldaunits (getvar "aunits")
	oldauprec (getvar "auprec")
	;;uctr	  (u_ctrl)
  )
  (HY_UndoM)
  (setvar "aunits" 1)
  (setvar "auprec" 3)
  ;;(setq sc (dw-sc))
  ;;(setq h (dw-txh))
  ;;(setq l (dw-txw))
   (setq sc (dl_getdrawingFactor))
  (setq h (Dl_GetTextHeight))
  (setq l (DL_GetDimPrec))
  (setq s1 (entget s))
  (setq	c  (cdr (assoc 10 s1))
	c1 (cdr (assoc 50 s1))
	c2 (cdr (assoc 51 s1))
	r  (cdr (assoc 40 s1))
  )
  (setq r2 (rtos r 2 l))
  (setq r1 (strcat "R=" (rtos r 2 l)))	;----r

  (setq dc (abs (- c1 c2)))
  (if (> dc pi)
    (setq dc (- (* 2 pi) dc))
  )
  (setq k (* dc r))
  (setq k2 (rtos k 2 l))
  (setq k (strcat "L=" (rtos k 2 l)))	;----L


  (setq c (p# c))
  (setq	p1 (polar c c1 r)
	p3 (polar c c2 r)
  )
  (setq p2 (polar p1 (+ (/ pi 2) (angle c p1)) 1))
  (setq p4 (polar p3 (+ (/ pi 2) (angle c p3)) 1))

  (setq i (inters p1 p2 p3 p4 nil))
  (setq t1 (distance i p1))
  (setq t2 (rtos t1 2 l))
  (setq t1 (strcat "T=" (rtos t1 2 l)))	;----t         

  (setq	a1 (angle p1 i)
	a2 (angle i p3)
  )
  (setq a (abs (- a1 a2)))
  (if (> a pi)
    (setq a (- (* 2 pi) a))
  )
  (setq a (* 180 (/ a pi)))
  (setq a2 (strcat (rtos a 2 l) "%%d"))
					;(setq a1(strcat "a=" (rtos a 2 l) "%%d"))           ;----a         
;;;11:38 AM 11/17/98
  (if (null strchth)
    (#ppls "Dim_pmbz")
  )
  ;;;(setq a1 (angtos a)
  (setq	a1 (angtos (* (/ a 180) pi))
	a1 (strcat "a=" (strchth a1 "d" "%%d"))
  )
;;;11:38 AM 11/17/98
  (setq d (distance c i))
  (setq d (- d r))
  (setq d2 (rtos d 2 l))
  (setq d (strcat "E=" (rtos d 2 l)))	;----d         
  (setq c1 (polar c (angle c i) r))

  (if (or (= key nil) (= key "Y"))
    (progn

      (if (>= r 15.0)
	(setq c (polar c1 (angle c1 c) (/ 30 sc)))
      )

      (setq a (angle c1 c))
      (if (< a 0.0)
	(setq a (+ a (* 2 pi)))
      )
      (setq ang1 (- (/ pi 1.75) (/ pi 2)))
      (setq ang2 (+ pi ang1))

      (setq p1 (polar c1 (angle c1 c) (/ 4.0 sc)))
      (setq p2 (polar p1 (+ (angle c1 c) (/ pi 2)) (/ 0.5 sc)))
      (SETQ ELAST (ENT_LAST))
      (command "line" c1 p2 p1 "")
      (if (null	(or (and (>= a 0.0) (<= a ang1))
		    (and (>= a ang2) (<= a (* 2 pi)))
		)
	  )
	(setq c2 c1
	      c1 c
	      c	 c2
	)
      )


      (command "line" c c1 "")

      (dw-dlh1 c c1 (list a1 r1 t1 k d) h sc)
      (SETQ SS (GET_LAST ELAST))
      (COMMAND ".-GROUP" "" "*" "" SS "")
    )
  )

  (hy_rv)
  (setvar "aunits" oldaunits)
  (setvar "auprec" oldauprec)
					;(list r2 a2 k2 t2 d2)
  (list a2 R2 t2 K2 d2)
)																				

(defun #dljdbh(/ lay uctr glb ss h w psc vsize sc  loop ent p pp p0 len n 
  ret_v s layc )
  (HY_Set0)
  ;;(setq LAY  (c_pps_chglay "HY_DL_JD_LAYER" "laysym" "laynam"))
  (setq LAY  "HY_DL_JD")
  ;;;(SETQ LAY "PP-DL-JD")
  (DL_MakeLayer LAY)
  ;;(SETQ UCTR (U_CTRL))  HY_ClearUNDO
  (SETQ UCTR (HY_ClearUNDO))  
  ;;(setq layc  (c_pps_chglay "HY_DL_AXIS_LAYER" "laysym" "laynam"))
  (setq layc  "Axis")
  (SETQ GLB (list (cons 8  layc) 
                  '(-4 . "<or") 
                  '(0 . "LINE") 
                  '(0 . "ARC") 
                  '(-4 . "or>") 
                  '(-3 ("DWAPP"))
            )
  )
  (SETQ SS (SSGET "X" (QUOTE ((2 . "DL-C")))))
  (IF (/= SS nil) (COMMAND "erase" SS ""))
  (SETQ H (Dl_GetTextHeight) W (DL_GetDimPrec))
  (SETQ PSC (DW-PSC 29.5))
  (SETQ VSIZE (GETVAR "viewsize"))
  (SETQ SC (dl_getdrawingFactor))
  (SETQ H (/ H SC))
  (SETQ LOOP T)
  (WHILE LOOP 
    ;;(SETQ ENT (MENTSEL "\n回车退出 / 回退 U / 选择道路中心线:" "LINE,ARC" layc nil "U"))
    (SETQ ENT (gpsseld (list (cons 0 "LINE,ARC") (cons 8 layc)) "\n回车退出 / 回退 U / 选择道路中心线:" "U"))
    (COND 
      ((NULL ENT) (SETQ LOOP nil)) 
      ((= ENT "RETURN")  (PROMPT "\n没选中道路中心线!")) 
      ((= ENT "U") 
        (IF (> (GETVAR "undomarks") UCTR) 
          (HY_UndoB) 
          (PROMPT "\n已全部回退!")
        )
      ) 
      (T 
      
        (SETQ P0 (p# (CADR ENT)) ENT (CAR ENT)) 
        (SETQ PP (#GET_PTB4 ENT P0 GLB)) 
        (SETQ LEN (LENGTH PP) N 0) 
        (hy_sv) 
        (WHILE (< N LEN) 
          (SETQ P (NTH N PP) N (1+ N)) 
          (SPAN (LIST (CAR P) (CADR P) 0.0)) 
          (IF (NOT (EQUAL VSIZE (SETQ VSIZE (GETVAR "viewsize")) 0.1)) 
            (SETQ PSC (DW-PSC 29.5))
          ) 
          (SETQ RET_V (#CH_BH P PSC)) 
          (COND 
            ((= RET_V "E") (SETQ N LEN LOOP nil)) 
            ((= RET_V "R") (SETQ N LEN))
          ) 
        )
        (hy_rv) 
        
      )
    )
  )
  (HY_Set1)
  (PRINC)
)																	
																				
;;;
(defun #get_ptb4 (ENT P0 GLB / PT1 PT2 PTB PT PTB1 flag p1 ss1)
  (setq flag t)
  (setq ss1 (ssadd))
  (ssadd ent ss1)
  
  (SETQ	PTB (BG-YPP ENT)
	PT1 (P# (last PTB))
	PT2 (P# (CAR PTB))
  )
  (IF (> (PMDIST PT1 P0) (PMDIST PT2 P0))
    (SETQ PT  PT1
	  PT1 PT2
	  PT2 PT
    )
  )
  (setq p1 pt1)
  (SETQ PTB (APPEND (LIST PT1) (#GET_PTB3 ENT PT1 GLB)))
  (WHILE (and flag (SETQ ENT (#ENTSELP PT2 GLB ss1)))
    (ssadd ent ss1)
    (SETQ PTB  (APPEND PTB (LIST PT2))
	  PTB1 (BG-YPP ENT)
	  PT   (P# (CAR PTB1))
    )
    (SETQ PTB (APPEND PTB (#GET_PTB3 ENT PT2 GLB)))
    (IF	(EQUAL PT PT2 0.01)
      (SETQ PT2 (P# (last PTB1)))
      (SETQ PT2 PT)
    )
    (if	(equal pt2 p1 0.01)
      (setq flag nil)
    )
  )
  (SETQ	PTB (APPEND PTB (LIST PT2))
	PTB (DWGLQ PTB)
  )
  (REVERSE PTB)
)
;;;																				
;;;
;;;
(defun #get_ptb3 (ENT P0 GLB / PT1 PT2 PTB)
  (SETQ	PTB (BG-YPP ENT)
	PT1 (P# (last PTB))
	PT2 (P# (CAR PTB))
	PTB nil
  )
  (IF (#IS_LINE ENT)
    (SETQ PTB (APPEND PTB (#GET_IPT ENT (#GET_SS ENT GLB))))
    (progn
    	(SETQ   PTB (APPEND PTB (#GET_IPT ENT (SSGET "f" (#DF_ENT ENT 5) GLB)))    )
  	)
  )
  
  (IF PTB
    (PROGN
      (SETQ PTB (DWGLQ PTB))
      (IF (< (PMDIST PT1 P0) (PMDIST PT2 P0))
	(SETQ PTB (P_LINE PT1 PTB))
	(SETQ PTB (P_LINE PT2 PTB))
      )
    )
  )
  PTB
)																				
;;;
(defun #df_ent (en n / ent ptb p1 p2 etype)
  (if (= (type en) 'ename)
    (setq etype (cdr (assoc 0 (entget en))))
  )
  (if (and etype
           (wcmatch etype "LINE,*POLYLINE,ARC,CIRCLE")
           (numberp n)
           (> n 1)
      )
    (progn
      (#undo_init)
      (command ".undo" "group")
      (setq ent (ent_last)
            ptb (bg-ypp en)
            p1  (last ptb)
            p2  (car ptb)
      )
      (if (= etype "CIRCLE")
        (setq ptb nil)
        (setq ptb (list p1))
      )
      (command ".divide" (list en p1) (fix n))
      (command ".undo" "e")
      (while (setq ent (entnext ent))
        (setq p1  (cdr (assoc 10 (entget ent)))
              ptb (append ptb (list p1))
        )
      )
      (command ".u")
      (if (/= etype "CIRCLE")
        (setq ptb (append ptb (list p2)))
      )
    )
    (prompt
      "\n无效参数! 用法:#df_ent(en n),en=LINE,*POLYLINE,ARC,CIRCLE;n>=1"
    )
  )
  ptb
)																				
;;;
(defun #get_ipt	(EN1 SS / EN2 P PT LEN N P1 P2 P3 P4 ENTB PTB f1 f2)
  (IF SS
    (PROGN
      (SETQ LEN	(SSLENGTH SS)
	    N	0
      )
      (REPEAT LEN
	(SETQ EN2 (SSNAME SS N)
	      N	  (1+ N)
	)
	(if (not (equal en1 en2))
	  (progn
;;;15:19 98-12-12
	    (setq p (ipt2e en1 en2))
	    (FOREACH PT	P
	      (SETQ PTB (CONS PT PTB))
	    )
	  )
	)
      )
    )
  )
  PTB
)
;;;																				
;;;
(defun #entselp	(PT GLB ss1 / HAND SCA P1 P2 SS N LEN FLAG ptb)
  (SETQ	SCA (* 0.707
	       (/ (* (GETVAR "pickbox") (GETVAR "viewsize")) 206.0)
	    )
  )
  (SETQ	P2 (POLAR PT (* PI 0.25) SCA)
	P1 (POLAR PT (* PI 1.25) SCA)
  )
  (SPAN P1)
  (SETQ SS (SSGET "C" P1 P2 GLB))
  (IF SS
    (PROGN
      (setq ss (sscl ss ss1))
      (if ss
	(SETQ LEN (SSLENGTH SS))
	(setq len 0)
      )
      (IF (> LEN 0)
	(IF (= LEN 1)
	  (progn
	    (SETQ ENT (SSNAME SS 0)
		  ptb (bg-ypp ent)
		  p1  (p# (car ptb))
		  p2  (p# (last ptb))
		  pt  (p# pt)
	    )
	    (if	(and (not (equal p1 pt 0.01))
		     (not (equal p2 pt 0.01))
		)
	      (setq ent nil)
	    )
	  )
	  (PROGN
	    (SETQ HAND (DW-SPP ENT "DWAPP" 1000))
	    (SETQ N 0)
	    (WHILE (< N LEN)
	      (SETQ ENT (SSNAME SS N))
	      (IF (= HAND (DW-SPP ENT "DWAPP" 1000))
		(SETQ N	LEN
		      FLAG T
		)
		(SETQ N (1+ N))
	      )
	    )
	    (IF	(NOT FLAG)
	      (SETQ ENT nil)
	    )
	  )
	)
	(SETQ ENT nil)
      )
    )
    (SETQ ENT nil)
  )
  ENT
)
;;;																				
;;;
(defun #ch_bh(pt psc /  p0 p1 p2 ss n wz p s pt ent ss1) 
  (setq bh (#get_pbh pt))
  (if (null bh) (progn
    ;;(COMMAND "insert" (STRCAT (PPSWL) "dwg\\dl-c") pt PSC "" 0) 
    (HY_UndoM)
	(szdl_ins_sysblk "dl-c" pt PSC PSC 0.0)
    (setq s (entlast))
    (setq bh (&sljdbh nil))
    (initget "E R")
    (setq pt2 (getpoint pt "\n回车不标 / 退出 E / 另选道路 R / 输入标注位置:"))
    (if (and pt2 (listp pt2)) (progn
      (hy_sv)
      (setq ss (ssget "C" (polar pt (* 0.25 pi) (/ 1.0 sca)) (polar pt (* 1.25 pi) (/ 1.0 sca))
                        '((-3 ("RJCDBH")) (0 . "INSERT") (2 . "DLSZ")))
      )
      (if ss (progn
        (setq ent (ssname ss 0))
        (HY_KZSJXZ ent "RJCDBH" 1000 bh)
        ) (progn
        ;;(command "insert" (strcat (ppswl) "dwg/dlsz") pt (/ 1.0 sca) "" 0.0)
        (szdl_ins_sysblk "dlsz" pt (/ 1.0 sca) (/ 1.0 sca) 0.0)
        (setq ent (entlast))
        (HY_KZSJXZ (entlast) "RJCDBH" 1000 bh)
      ))
      (&rjdbhbz pt pt2 bzh bh xwg ent)
      (if (= (type (read (substr bh (strlen bh)))) 'INT) (progn
        (setq str "" ns1 (strlen bh) zjz "T" num nil)
        (while zjz
          (if (= (type (read (substr bh ns1 1))) 'INT) 
            (progn
              (setq ns1 (- ns1 1))
              (if (= ns1 0) (setq zjz nil))
            ) 
            (setq zjz nil)
          )
        )
        (if (= ns1 0) 
          (setq bht "" num (read bh))
          (progn
            (setq bht (substr bh 1 ns1))
            (if (/= ns1 (strlen bh)) 
              (setq num (read (substr bh (+ ns1 1))))
            )
          )
        )
      ))
      (hy_rv)
    ))
    (entdel s)
  ))
  pt2
)																				
;;;
(defun #get_pbh(pt / ent bh)
  (if (setq ent (mentselp pt '((-3 ("RJCDBH")) (0 . "INSERT") (2 . "DLSZ")) nil))
    (setq bh (dw-spp ent "RJCDBH" 1000))
  )
  bh
)
;;;																				
;;;
(defun #get_ss (ENT GLB / PTB PI2 P1 P2 ANG W X Y PT)
  (SETQ	PI2 (/ PI 2)
	W   4
  )
  (IF (#IS_LINE ENT)
    (PROGN
      (SETQ PTB	(BG-YPP ENT)
	    P1	(P# (last PTB))
	    P2	(P# (CAR PTB))
	    ANG	(ANGLE P1 P2)
	    PTB	nil
	    PT	(POLAR P1 (- ANG PI2) W)
	    PTB	(CONS PT PTB)
	    PT	(POLAR P2 (- ANG PI2) W)
	    PTB	(CONS PT PTB)
	    PT	(POLAR P2 (+ ANG PI2) W)
	    PTB	(CONS PT PTB)
	    PT	(POLAR P1 (+ ANG PI2) W)
	    PTB	(CONS PT PTB)
      )
    )
  )
  (zm2pt p1 p2)
  (SSGET "cp" PTB GLB)
)																				
(defun &zdlzxd2	(pt		 /		 ss		 p01	 ns		 ns1	 ent	 wb		 jcdb
								 p1		 p2		 ang	 an1	 an2	 r_cir z1		 z2		 zjz
								 ent2	 ns2	 ns3	 biao	 p11	 p12	 p02	 an12	 an22
								 jcdb2 laynam_zxx
								)
	;;(setq laynam_zxx (c_pps_chglay "HY_DL_AXIS_LAYER" "laysym" "laynam"))
	(setq laynam_zxx  "Axis")
	(setq	ss (ssget	"C"
									(polar pt (* pi 0.25) 3.5)
									(polar pt (* pi 1.25) 3.5)
									(list '(-4 . "<or")
										'(0 . "ARC")
										'(0 . "LINE")
										'(-4 . "or>")
										(cons 8 laynam_zxx)
									 )
					 )
	)
	(if	ss
		(progn
			(setq	ns	 (sslength ss)
						ns1	 0
						jcdb nil
			)
			(repeat	ns
				(setq	ent	 (ssname ss ns1)
							wb	 (entget ent '("DWAPP"))
							enlx (cdr (assoc 0 wb))
				)
				(if	(= enlx "LINE")
					(progn
						(setq	p1	(cdr (assoc 10 wb))
									p2	(cdr (assoc 11 wb))
									ang	(angle p1 p2)
						)
						(setq	p01	(interss p1
															 p2
															 (polar pt (+ ang (* pi 0.5)) 1026.0)
															 pt
															 nil
											)
						)
						(cond
							((< (pmdist p01 p1) 1.5)
							 (setq p01 p1)
							)
							((< (pmdist p01 p2) 1.5)
							 (setq p01 p2)
							)
						)
						(if	(< (pmdist p01 p1) (pmdist p01 p2))
							(setq p01 p1)
							(setq p01 p2)
						)
						(setq	z1 (caddr p1)
									z2 (caddr p2)
						)
						(if	(and (/= z1 0.0) (/= z2 0.0))
							(setq	zjz	(+ z1
													 (* (/ (pmdist p01 p1) (pmdist p1 p2)) (- z2 z1))
												)
										p01	(list (car p01) (cadr p01) zjz)
							)
							(setq zjz nil)
						)
						(setq
							jcdb (cons (list (list p01 zjz) (pmdist pt p01)) jcdb)
						)
						(if	(and (> ns 1) (< ns1 (- ns 1)))
							(progn
								(setq	ns2	(- ns ns1 1)
											ns3	(+ ns1 1)
								)
								(repeat	ns2
									(setq	ent2 (ssname ss ns3)
												biao (entget ent2 '("DWAPP"))
									)
									(if	(= (cdr (assoc 0 biao)) "LINE")
										(progn
											(setq	p11	(cdr (assoc 10 biao))
														p12	(cdr (assoc 11 biao))
														p02	(interss p1 p2 p11 p12 "T")
											)
											(if	p02
												(setq	jcdb2
															 (cons
																 (list (list p02 zjz) (pmdist p02 pt))
																 jcdb2
															 )
												)
											)
										)
										(progn
											(setq wb (calali p1 p2 biao))
											(foreach biao	wb
												(if	(< (pmdist pt biao) 10.0)
													(setq	jcdb2	(cons	(list	(list biao zjz)
																									(pmdist biao pt)
																						)
																						jcdb2
																			)
													)
												)
											)
										)
									)
									(setq ns3 (+ ns3 1))
								)
							)
						)
					)
					(progn
						(setq	p02		(cdr (assoc 10 wb))
									an1		(cdr (assoc 50 wb))
									an2		(cdr (assoc 51 wb))
									r_cir	(cdr (assoc 40 wb))
									ang		(angle p02 pt)
									p1		(polar p02 an1 r_cir)
									p2		(polar p02 an2 r_cir)
									p01		(polar p02 (angle p02 pt) r_cir)
						)
						(cond
							((< (pmdist p02 p1) 1.5) (setq p01 p1))
							((< (pmdist p02 p2) 1.5) (setq p01 p2))
						)
						(if	(< (pmdist p01 p1) (pmdist p01 p2))
							(setq p01 p1)
							(setq p01 p2)
						)
						(setq ang (angle p02 p01))
						;;精度范围内比较
						(if (equal ang an1 0.000001)
						    (setq ang an1)
						)
						(if (equal ang an2 0.000001)
						    (setq ang an2)
						)
					       ;;用精度比较浮点数，以前的的直接比较有问题
						(if	(< an2 an1)
							(setq an2 (+ an2 (* pi 2.0)))
						)
						(if	(< ang an1)
							(setq ang (+ ang (* pi 2.0)))
						)
						;;用精度比较浮点数，以前的的直接比较有问题
						(if	(and (<= ang an2) (>= ang an1))
							(progn
								(if	(assoc -3 wb)
									(progn
										(setq zjz (cdr (assoc 1010 (cdadr (assoc -3 wb)))))
										(if	zjz
											(progn
												(setq	z1 (car zjz)
															z2 (cadr zjz)
												)
												(if	(and z1 z2)
													(progn
														(if	(> an2 an1)
															(setq ll1 (* r_cir (- an2 an1)))
															(setq	ll1
																		 (* r_cir (- (+ an2 (* pi 2.0)) an1))
															)
														)
														(if	(> ang an1)
															(setq ll2 (* r_cir (- ang an1)))
															(setq	ll2
																		 (* r_cir (- (+ ang (* pi 2.0)) an1))
															)
														)
														(setq zjz (+ z1 (* (/ ll2 ll1) (- z2 z1))))
													)
													(setq zjz nil)
												)
											)
										)
									)
									(setq zjz nil)
								)
								(setq	jcdb
											 (cons (list (list p01 zjz) (pmdist pt p01)) jcdb)
								)
								(if	(and (> ns 1) (< ns1 (- ns 1)))
									(progn
										(setq	ns2	(- ns ns1 1)
													ns3	(+ ns1 1)
										)
										(repeat	ns2
											(setq	ent2 (ssname ss ns3)
														biao (entget ent2 '("DWAPP"))
											)
											(if	(= (cdr (assoc 0 biao)) "LINE")
												(progn
																				;(setq wb (calali p1 p2 biao))
													(setq wb (ipt_la ent ent2))
													(foreach biao	wb
														(if	(< (pmdist pt biao) 10.0)
															(setq	jcdb2	(cons	(list	(list biao zjz)
																											(pmdist biao pt)
																								)
																								jcdb2
																					)
															)
														)
													)
												)
												(progn
													(setq wb (ipt_aa ent ent2))
													(foreach biao	wb
														(if	(< (pmdist pt biao) 10.0)
															(setq	jcdb2	(cons	(list	(list biao zjz)
																											(pmdist biao pt)
																								)
																								jcdb2
																					)
															)
														)
													)
												)
											)
											(setq ns3 (+ ns3 1))
										)
									)
								)												;end of if ns ns1
							)
						)														;end of if ang an2 an1
					)
				)
				(setq ns1 (+ ns1 1))
			)
			(setq	jcdb (lispx (append jcdb jcdb2))
						p01	 (caar jcdb)
			)
			(if	(= (cadr p01) nil)
				(progn
					(setq	jcdb (cdr jcdb)
								zjz	 nil
					)
					(foreach wb	jcdb
						(setq wb (car wb))
						(if	(and (= zjz nil)
										 (< (pmdist (car p01) (car wb)) 0.05)
										 (cadr wb)
								)
							(setq	p01	(list (car p01) (cadr p01) (cadr wb))
										zjz	"T"
							)
						)
					)
				)
			)
		)
	)
	p01
)																				;end of defun																				
;;;
(defun &dljdhb( / sca rjdbxzb rjdbmb rjdbinrb ss ns ns1 jdbhb ent wb pt bh pt2
       dcl_id what curjcdh insbz wjm dmbg laynam_zbb )
 (setvar "blipmode" 0)
 (setvar "cmdecho" 0)
 ;;(setq laynam_zbb (c_pps_chglay "HY_BL_DLZB_LAYER" "laysym" "laynam"))
 ;;(mk_ly laynam_zbb)
 (setq laynam_zbb "HY_BL_DLZB")
 (DL_MakeLayer laynam_zbb)
 (hy_sv)
 (setq sca (dl_getdrawingFactor) errkey "error" errval "没选择或输入道路控制点.")
 (setq rjdbxzb '("yn2" "yn3" "yn4" "yn5"))
 (setq rjdbmb '("编号" "测量坐标系" "施工坐标系" "设计标高" "备注")
       rjdbinrb '(("yn1" 0 nil "STR") ("yn2" 0 nil "REAL") ("yn3" 0 nil "REAL") 
                  ("yn4" 0 nil "REAL") ("yn5" 0 nil "STR"))
 )
 (setq dcl_id (load_dialog (strcat (HY_GetInstallDir) "commres/dcl/&dljdhb")) what 2)
 (if (not (new_dialog "dljdhb" dcl_id)) (exit))
 (action_tile "accept" "(if (&jcrjdb) (done_dialog 4))")
 (action_tile "cancel" "(done_dialog 0)")
 (foreach wb rjdbxzb
    (set_tile wb "1")
 )
 (setq what (start_dialog))
 (unload_dialog dcl_id)
 (if (= what 4) (progn
   (prompt "\n选择要绘表道路节点编号:")
   (setq ss (ssget '((-3 ("RJCDBH")) (0 . "INSERT") (2 . "DLSZ"))) )
   (if ss (progn
     (setq ns (sslength ss) ns1 0 jdbhb nil)
     (repeat ns
      (setq ent (ssname ss ns1) pt (cdr (assoc 10 (entget ent)))
            bh (cdr (assoc 1000 (cdadr (assoc -3 (entget ent '("RJCDBH")) ))))
      )
      (setq pt2 (&zdlzxd pt) dmbg (cadr pt2))
      
      (if (null dmbg)(setq dmbg (#tsjbg_p (p# pt))));;;modi yft
       
      (setq jdbhb (cons (list bh (HY_TransCoord pt 0) pt dmbg) jdbhb))
      (setq ns1 (+ ns1 1))
     )
     (setq jdbhb (&strpx jdbhb))
     (&hzrjdbb) 
   ))
 ))
 (hy_rv)
 (setvar "blipmode" 1)
 (setvar "cmdecho" 1)
 (princ)
)																				
;
(defun &jcrjdb( / ns ns1 wb   )
 (setq rjdbxzb nil ns 4 ns1 2 zjz "T")
 (repeat ns
  (setq wb (get_tile (strcat "yn" (itoa ns1))) )
  (if (= wb "1")
    (setq rjdbxzb (cons (strcat "yn" (itoa ns1)) rjdbxzb))
    (setq rjdbxzb (cons nil rjdbxzb))
  )
  (setq ns1 (+ ns1 1))
 )
 (setq rjdbxzb (reverse rjdbxzb) rjdbxzb (cons "yn1" rjdbxzb))
 zjz
)    ;end of defun
;																				
;
(defun &zdlzxd(pt / ss p01 ns ns1 ent wb jcdb p1 p2 ang an1 an2 r_cir z1 z2 
       zjz laynam_zxx )
 ;;(setq laynam_zxx (c_pps_chglay "HY_DL_AXIS_LAYER" "laysym" "laynam"))
 (setq laynam_zxx "Axis")
 (setq ss (ssget "C" (polar pt (* pi 0.25) 1.5) (polar pt (* pi 1.25) 1.5)
   (list '(-4 . "<or") '(0 . "ARC") '(0 . "LINE") '(-4 . "or>") (cons 8 laynam_zxx) '(-3 ("DWAPP")))
          )
 )
 (if ss (progn
   (setq ns (sslength ss) ns1 0 jcdb nil)
   (repeat ns
    (setq ent (ssname ss ns1) wb (entget ent '("DWAPP")) 
          enlx (cdr (assoc 0 wb)) 
    )
    (if (= enlx "LINE") (progn
      (setq p1 (cdr (assoc 10 wb)) p2 (cdr (assoc 11 wb)) ang (angle p1 p2))
      (setq p01 (interss p1 p2 (polar pt (+ ang (* pi 0.5)) 1026.0) pt nil))
      (cond
       ((< (pmdist p01 p1) 1.5) (setq p01 p1))
       ((< (pmdist p01 p2) 1.5) (setq p01 p2))
      )
      (setq z1 (caddr p1) z2 (caddr p2) )
      (if (and (/= z1 0.0) (/= z2 0.0))
        (setq zjz (+ z1 (* (/ (pmdist p01 p1) (pmdist p1 p2)) (- z2 z1)))
              p01 (list (car p01) (cadr p01) zjz)
        )
        (setq zjz nil)
      )
      (setq jcdb (cons (list (list p01 zjz) (pmdist pt p01)) jcdb))
     ) (progn
      (setq p01 (cdr (assoc 10 wb)) an1 (cdr (assoc 50 wb)) an2 (cdr (assoc 51 wb))
            r_cir (cdr (assoc 40 wb)) ang (angle p01 pt)
            p1 (polar p01 an1 r_cir) p2 (polar p01 an2 r_cir)
            p01 (polar p01 (angle p01 pt) r_cir)
      )
      (cond
       ((< (pmdist p01 p1) 0.5) (setq p01 p1))
       ((< (pmdist p01 p2) 0.5) (setq p01 p2))
      )
      (if (assoc -3  wb) (progn
        (setq zjz (cdr (assoc 1010 (cdadr (assoc -3 wb)))) )
        (if zjz (progn
          (setq z1 (car zjz) z2 (cadr zjz))
          (if (and z1 z2) (progn
            (if (> an2 an1)
              (setq ll1 (* r_cir (- an2 an1)))
              (setq ll1 (* r_cir (- (+ an2 (* pi 2.0)) an1)))
            )
            (if (> ang an1)
              (setq ll2 (* r_cir (- ang an1)))
              (setq ll2 (* r_cir (- (+ ang (* pi 2.0)) an1)))
            )
            (setq zjz (+ z1 (* (/ ll2 ll1) (- z2 z1))) )
           ) (setq zjz nil)
          )
        ))
       ) (setq zjz nil)
      )
      (setq jcdb (cons (list (list p01 zjz) (pmdist pt p01)) jcdb))
    ))
    (setq ns1 (+ ns1 1))
   )
   (setq jcdb (lispx jcdb) p01 (caar jcdb))
   (if (= (cadr p01) nil) (progn
     (setq jcdb (cdr jcdb) zjz nil)
     (foreach wb jcdb
       (setq wb (car wb))
       (if (and (= zjz nil) (< (pmdist (car p01) (car wb)) 0.05) (cadr wb))
         (setq p01 (list (car p01) (cadr wb)))
       )
     )
   ))
 ))
 p01
)    ;end of defun
;																				
;;;
;;;para: point p or (list p e) or (list e p) or (list e p zheb) or (list p e zheb)
;;;10:44 98-10-23
(defun #tsjbg_p(p / tmp p1 p2 bgb bg glb ent regn ptb i zheb layc)
  ;;(setq layc   (c_pps_chglay "HY_DL_AXIS_LAYER" "laysym" "laynam"))
  (setq layc  "Axis")
  (SETQ GLB (list (cons 8 layc) 
                  '(-4 . "<or") 
                  '(0 . "LINE,*POLYLINE") 
                  '(0 . "ARC") 
                  '(-4 . "or>") 
                  '(-3 ("DWAPP"))
            )
  )
  (if (numberp (caddr p))
    (setq p (p# p))
  )
  (setq zheb (cadddr p))
  (if (numberp (car p))
    (progn
      (setq ent (mentselps p 2.0 glb nil))
      (if ent (progn
        (if (null #p_on_l) (#ppls "#dlzh"))
        (setq i 0) 
        (while (and (< i 5) ent (not (#p_on_l (list ent) p)))
          (setq ent (mentselps p 2.0 glb ent) i (1+ i))
        )
      ))
    )
    (progn
      (if (= (type (car p)) 'ENAME)
        (setq ent (car p) p (p#(cadr p)))
        (setq ent (cadr p) p (p#(car p)))
      )
    )
  )
  (if ent(progn
    (if (null #len_pe) (#ppls "Dim_pmbz"))
    (setq tmp (#len_pe p ent)
          ptb (bg-ypp ent)
          p1 (last ptb)
          p2 (car ptb)
          regn "DWAPP"
    )
  ))
  (if regn (progn
    (if (#is_line ent)
      (setq bgb (list (caddr p1) (caddr p2)))
      (setq bgb (dw-spp ent regn 1010))
    )
    (setq sbg (car bgb)
          ebg (cadr bgb)
    )
    (cond
      ((and sbg (not (zerop sbg)) (equal p (p# p1) 0.01)) (setq bg sbg))
      ((and ebg (not (zerop ebg)) (equal p (p# p2) 0.01)) (setq bg ebg))
      (t
        (if (and sbg ebg (not (zerop sbg)) (not (zerop ebg)))
          (setq bg (/ (+ (* (car tmp) ebg) (* (cadr tmp) sbg)) (caddr tmp) ))
          (progn
            (setq zh (#get_zh (list p ent)))
            (if zh 
              (cond
                (zheb (setq bg (#getsjbg_p (list zh zheb))))
                (ent  (setq bg (#getsjbg_p (list zh ent))))
              )
            )
          )
        )  
      )
    )
  ))
  (if (and bg (zerop bg)) (setq bg nil))
  bg
)	
;;
(defun &strpx(lis /  ns ns1 wb biao zjz ns2 lis2 zjz2 bht num str1 str2 )
 (setq ns (length lis) ns1 0 lis2 lis)
 (repeat ns
  (setq wb (nth ns1 lis2))
  (if (/= (type wb) 'LIST)
    (setq str1 (strcase (scanb wb)) )
    (setq str1 (strcase (scanb (car wb))) )
  )
  (setq wb2 (&fljdbh str1))
  (if (< ns1 (- ns 1)) (progn
    (setq ns2 (+ ns1 1))
    (while (<= ns2 (- ns 1))
     (setq biao (nth ns2 lis2))
     (if (/= (type biao) 'LIST)
       (setq str2 (strcase (scanb biao)) )
       (setq str2 (strcase (scanb (car biao))) )
     )
     (setq wb3 (&fljdbh str2))
     (cond
      ((= (car wb2) (car wb3))
       (if (< (cadr wb3) (cadr wb2))
         (setq zjz biao biao wb wb zjz
               lis2 (lismod lis2 ns1 wb) lis2 (lismod lis2 ns2 biao)
               zjz wb3 wb3 wb2 wb2 zjz
         )
       )
      )
      ((< (car wb3) (car wb2))
       (setq zjz biao biao wb wb zjz
             lis2 (lismod lis2 ns1 wb) lis2 (lismod lis2 ns2 biao)
             zjz wb3 wb3 wb2 wb2 zjz
       )
      )
     )
     (setq ns2 (+ ns2 1))
    )
  ))
  (setq ns1 (+ ns1 1))
 )
 lis2
)
;
(defun &fljdbh(bh / str ns1 zjz num bht  )
 (if (= (type (read (substr bh (strlen bh)))) 'INT) (progn
   (setq str "" ns1 (strlen bh) zjz "T" num nil)
   (while zjz
    (if (= (type (read (substr bh ns1 1))) 'INT) (progn
      (setq ns1 (- ns1 1))
      (if (= ns1 0) (setq zjz nil))
     ) (setq zjz nil)
    )
   )
   (if (= ns1 0) 
    (setq bht "" num (read bh))
    (progn
     (setq bht (substr bh 1 ns1))
     (if (/= ns1 (strlen bh)) 
       (setq num (read (substr bh (+ ns1 1))))
     )
   ))
  ) (setq bht bh num nil)
 )
 (list bht num)
)   ;end of defun
;
;
(defun &hzrjdbb( / pt zbxmb zbxmmb hgg hzg xwg pt2 pt3 str str2 rjdbsjzb dl 
       dl2 wb bgzk ns ns1 num rjdbxzzb key ynns nulx ff pa pb pt4 dkcs dkcs2
       xmdhb ns2 ns3 )
 ;;;读取标注位数start
 (setq wg_txw (DL_GetDimPrec))
 ;;;end 
 (setq xmdhb '("BH" "CB" "SB" "BG" "BZ"))
 (foreach wb rjdbxzb
   (if wb (setq rjdbxzzb (cons wb rjdbxzzb)) )
 )
 (setq rjdbxzzb (reverse rjdbxzzb) rjdbsjzb jdbhb )
 (setq zbxmmb '(("BH" "编号") ("CB" "测量坐标系") ("SB" "施工坐标系") 
                ("BG" "设计标高") ("BZ" "备注")) 
 )
 (setq zbxmb '(("BH" 15) ("CB" (30 30)) ("SB" (30 30)) ("BG" 30) ("BZ" 30)) ) 
 (setq hgg (/ 8.0 sca) hzg (/ 5.0 sca) xwg (/ 3.5 sca) bgzk 0.0)
 (foreach ff rjdbxzzb
   (setq ns (- (read (substr ff 3)) 1) wb (assoc (nth ns xmdhb) zbxmb))
   (cond
    ((/= (type (cadr wb)) 'LIST)
     (setq bgzk (+ bgzk (cadr wb)))
    )
    ((= (type (cadr wb)) 'LIST)
     (foreach num (cadr wb)
       (setq bgzk (+ bgzk num))
     )
    )
   )
 )
 (setq bgzk (/ bgzk sca))
 (initget 1)
 (setq pt (getpoint "\n输入表格左上角:"))
 (command "pline" pt "w" (/ 0.4 sca) "" (polar pt 0.0 bgzk) "")
 (command "text" "c" (polar (polar pt 0.0 (* bgzk 0.5)) (* pi 0.5) (/ 2.5 sca))
    (* hzg 1.4) 0.0 "道路控制点坐标表"
 )
 (setq pt (polar pt (* pi 1.5) (/ 16.0 sca)) )
 (command "pline" pt "w" (/ 0.4 sca) "" (polar pt 0.0 bgzk) "")
 (setq dl 0.0)
 (foreach ff rjdbxzzb
    (setq num (- (read (substr ff 3)) 1) str (cadr (assoc (nth num xmdhb) zbxmmb))
          wb  (cadr (assoc (nth num xmdhb) zbxmb))
          pt2 (polar pt 0.0 dl)
    )
    (command "line" pt2 (polar pt2 (* pi 0.5) (/ 16.0 sca)) "")
    (cond
     ((= (nth num xmdhb) "CB")
      (setq dl2 (apply '+ wb) 
            pt3 (polar (polar pt2 0.0 (/ dl2 sca 2.0)) (* pi 0.5) (/ 12.0 sca)) 
      )
      (command "text" "m" pt3 hzg 0.0 str)
      (setq pt3 (polar pt2 (* 0.5 pi) (/ 8.0 sca)) )
      (command "line" pt3 (polar pt3 0.0 (/ dl2 sca)) "")
      (setq pt3 (polar pt2 (* 0.5 pi) (/ 4.0 sca)) )
      (command "text" "m" (polar pt3 0.0 (/ dl2 4.0 sca)) hzg 0.0 "横向Y")
      (command "text" "m" (polar pt3 0.0 (/ (* dl2 0.75) sca)) hzg 0.0 "纵向X")
      (setq pt3 (polar pt2 0.0 (/ dl2 sca 2.0)) )
      (command "line" pt3 (polar pt3 (* 0.5 pi) (/ 8.0 sca)) "")
     )
     ((= (nth num xmdhb) "SB")
      (setq dl2 (apply '+ wb) 
            pt3 (polar (polar pt2 0.0 (/ dl2 sca 2.0)) (* pi 0.5) (/ 12.0 sca)) 
      )
      (command "text" "m" pt3 hzg 0.0 str)
      (setq pt3 (polar pt2 (* 0.5 pi) (/ 8.0 sca)) )
      (command "line" pt3 (polar pt3 0.0 (/ dl2 sca)) "")
      (setq pt3 (polar pt2 (* 0.5 pi) (/ 4.0 sca)) )
      (command "text" "m" (polar pt3 0.0 (/ dl2 4.0 sca)) hzg 0.0 "横向B")
      (command "text" "m" (polar pt3 0.0 (/ (* dl2 0.75) sca)) hzg 0.0 "纵向A")
      (setq pt3 (polar pt2 0.0 (/ dl2 sca 2.0)) )
      (command "line" pt3 (polar pt3 (* 0.5 pi) (/ 8.0 sca)) "")
     )
     (t
      (setq dl2 wb)
      (&zbtj_xgj (polar pt2 0.0 (/ dl2 sca)) (strcat str) (/ wb sca) (/ 16.0 sca))
     )
    )
    (setq dl (+ dl (/ dl2 sca)) )
 )
 (setq pt2 (polar pt 0.0 bgzk))
 (command "line" pt2 (polar pt2 (* pi 0.5) (/ 16.0 sca)) "")
 (setq dl hgg ns1 0 ns (length rjdbsjzb) ydh 1 )
 (repeat ns
  (setq pt2 (polar pt (* 1.5 pi) dl) dkcs (nth ns1 rjdbsjzb))
  (if (/= ns1 (- ns 1))
   (command "line" pt2 (polar pt2 0.0 bgzk) "")
   (progn
    (command "pline" pt2 (polar pt2 0.0 bgzk) "")
    (command "line" pt2 pt "")
    (setq dl2 0.0)
    (foreach ff rjdbxzzb
       (setq num (- (read (substr ff 3)) 1)
             wb (cadr (assoc (nth num xmdhb) zbxmb))
       )
       (if (= (type wb) 'LIST)
        (progn
         (foreach pa wb
           (setq dl2 (+ dl2 (/ pa sca)) )
           (setq pt3 (polar pt2 0.0 dl2))
           (command "line" pt3 (polar pt3 (* pi 0.5) (* ns hgg)) "")
         )
        ) (progn
         (setq dl2 (+ dl2 (/ wb sca)) )
         (setq pt3 (polar pt2 0.0 dl2))
         (command "line" pt3 (polar pt3 (* pi 0.5) (* ns hgg)) "")
       ))
    )
  ))
  (setq dl2 0.0 pt3 (polar pt2 (* 0.5 pi) (* hgg 0.5)))
  (foreach ff rjdbxzzb
     (setq num (- (read (substr ff 3)) 1) nulx (cadddr (nth num rjdbinrb))
           wb (cadr (assoc (nth num xmdhb) zbxmb))
     )
     (if (= (type wb) 'LIST)
      (progn
       (setq pb (nth num dkcs) ns2 0)
       (foreach pa wb
         (setq dl2 (+ dl2 (/ pa sca)) )
         (if (and pb (nth ns2 pb))
           (command "text" "m" (polar pt3 0.0 (- dl2 (/ pa sca 2.0)))
              xwg 0.0 (rtos (nth ns2 pb) 2 wg_txw);//测量坐标和施工坐标的标注
           )
         )
         (setq ns2 (+ ns2 1))
       )
      ) (progn
       (setq dl2 (+ dl2 (/ wb sca)) )
       (cond
        ((= nulx "STR")
         (if (= (nth num xmdhb) "BZ")
           (command "text" "m" (polar pt3 0.0 (- dl2 (/ wb sca 2.0))) xwg 0.0 "")
           (if (nth num dkcs)
             (command "text" "m" (polar pt3 0.0 (- dl2 (/ wb sca 2.0))) 
                xwg 0.0 (nth num dkcs)
             )
           )
         )
        )
        ((= nulx "REAL")
         (if (nth num dkcs)
           (command "text" "m" (polar pt3 0.0 (- dl2 (/ wb sca 2.0)))
              xwg 0.0 (rtos (nth num dkcs) 2 wg_txw);//设计标高标注
           )
         )
        )
        ((= nulx "INT")
         (if (nth num dkcs)
           (command "text" "m" (polar pt3 0.0 (- dl2 (/ wb sca 2.0)))
              xwg 0.0 (itoa (nth num dkcs))
           )
         )
        )
       )
     ))
     
  )
  (setq ns1 (+ ns1 1) dl (+ dl hgg))
 ) 
)    ;end of defun
;	
;
(defun &zbtj_xgj(pt str wb ht / ns ns1 ns2 ns3 xh pa str2  )
 (setq ns (strlen str))
 (cond
  ((<= ns 6)
   (setq pa (polar (polar pt pi (/ wb 2.0)) (* pi 0.5) (/ ht 2.0)))
   (&sxdw str pa hzg "M" 0.0)
  )
  ((<= ns 12)
   (setq pa (polar (polar pt pi (/ wb 2.0)) (* pi 0.5) (* ht 0.667)))
   (setq xh t str2 "" ns1 1 ns2 (/ (+ ns 1) 2))
   (while xh
    (if (>= (ascii (substr str ns1 1)) 175)
      (setq str2 (strcat str2 (substr str ns1 2)) ns1 (+ ns1 2))
      (setq str2 (strcat str2 (substr str ns1 1)) ns1 (+ ns1 1))
    )
    (if (>= ns1 ns2) (setq xh nil))
   )
   (if (= (substr str2 (strlen str2)) "^")
     (setq str2 (strcat str2 (substr str ns1 1)) ns1 (+ ns1 1))
   )
   (&sxdw str2 pa hzg "M" 0.0)
   (setq pa (polar (polar pt pi (/ wb 2.0)) (* pi 0.5) (* ht 0.333)) )
   (&sxdw (substr str ns1) pa hzg "M" 0.0)
  )
  (t
   (setq pa (polar (polar pt pi (/ wb 2.0)) (* pi 0.5) (* ht 0.833)))
   (setq xh t str2 "" ns1 1 ns2 (/ (+ ns 2) 3) ns3 1 ns 1)
   (while xh
    (if (>= (ascii (substr str ns1 1)) 175)
      (setq str2 (strcat str2 (substr str ns1 2)) ns1 (+ ns1 2) ns3 (+ ns3 2))
      (setq str2 (strcat str2 (substr str ns1 1)) ns1 (+ ns1 1) ns3 (+ ns3 1))
    )
    (if (>= ns3 ns2) (progn
      (if (= (substr str2 (strlen str2)) "^")
        (setq str2 (strcat str2 (substr str ns1 1)) ns1 (+ ns1 1))
      )
      (&sxdw str2 pa (* hzg 0.8) "M" 0.0)
      (setq pa (polar pa (* 1.5 pi) (* 0.333 ht)) )
      (setq str2 "" ns3 1 ns (+ ns 1))
      (if (> ns 2) (setq xh nil))
    ))
   )
   (&sxdw (substr str ns1) pa (* hzg 0.8) "M" 0.0)
  )
 )
)    ;end of defun
;		
;;;16:30 98-10-22
;;;参数:zh ent or (list zh zheb)
(defun #getsjbg_p (zh / ss len n ent ptb p1 p2 zhb bgb sbg ebg zheb eb zhbgeb bg pzh szh ezh
           minzh maxzh minzhbg maxzhbg)
  (cond 
    ((= (type (cadr zh)) 'ENAME)
      (setq regn (#get_ern (cadr zh)))
      (if regn (progn 
        (setq ss (ssget "x" (list (list -3 (list regn))) ))
        (setq len (sslength ss) n 0)
        (repeat len
          (setq ent (ssname ss n)
                ptb (bg-ypp ent)
                p1 (last ptb)
                p2 (car ptb)
                ;;zhb  (qq10xx ent regn 1010)
                zhb  (HY_QQ10xx ent regn 1010)
                n (1+ n)
          )
          (if (#is_line ent)
            (setq bgb (list (caddr p1) (caddr p2)))
            (setq bgb (HY_QQ10xx ent "DWAPP" 1010))
          )
          (setq sbg (car bgb) ebg (cadr bgb))
          (if (and sbg (not (zerop sbg)) (not (assoc (car zhb) zhbgeb)))
            (setq zhbgeb (append zhbgeb (list (list (car zhb) sbg ent) )))
          )
          (if (and ebg (not (zerop ebg)) (not (assoc (cadr zhb) zhbgeb)))
            (setq zhbgeb (append zhbgeb (list (list (cadr zhb) ebg ent) )))
          )
        )
      ))
    )
    (t
      (setq zheb (caadr zh))
      (foreach eb zheb
        (setq ent (cadr eb)
              ptb (bg-ypp ent)
              p1 (last ptb)
              p2 (car ptb)
              zhb (car eb)
        )
        (if (#is_line ent)
          (setq bgb (list (caddr p1) (caddr p2)))
          (setq bgb (HY_QQ10xx ent "DWAPP" 1010))
        )
        (setq sbg (car bgb) ebg (cadr bgb))
        (if (and sbg (not (zerop sbg)) (not (assoc (car zhb) zhbgeb)))
          (setq zhbgeb (append zhbgeb (list (list (car zhb) sbg ent) )))
        )
        (if (and ebg (not (zerop ebg)) (not (assoc (cadr zhb) zhbgeb)))
          (setq zhbgeb (append zhbgeb (list (list (cadr zhb) ebg ent) )))
        )
      )  
    )  
  )
  (if zhbgeb (progn
    (setq zhbgeb (ptbxpx zhbgeb)
          len (length zhbgeb)
          pzh (car zh)
          minzh (caar zhbgeb)
          maxzh (car (last zhbgeb))
          minzhbg (cadar zhbgeb)
          maxzhbg (cadr (last zhbgeb))
    )
    (cond
      ((<= pzh minzh)
        (setq bg minzhbg)
      )
      ((>= pzh maxzh)
        (setq bg maxzhbg)
      )
    )
    (if (null bg) (progn
      (while (> pzh (caadr zhbgeb)) (setq zhbgeb (cdr zhbgeb)))
      (setq sbg (cadar zhbgeb) ebg (cadadr zhbgeb)
            szh (caar zhbgeb)  ezh (caadr zhbgeb)  
            bg (/ (+ (* (abs (- pzh szh)) ebg) (* (abs (- ezh pzh)) sbg)) (abs (- ezh szh)) )
      )
    ))
  ))
  bg
)

(defun &gdljdh (/			sca		xh		pt		bh		xh2		pt2		ss		ent
								wb		sx1		ns		ns1		bht		str		xwg		zjz		num
								pa		pb		an1		an2		bzh		r_cir	stbh	laynam_jdbz
							 )
	(setvar "blipmode" 0)
	(setvar "cmdecho" 0)
	;;(setq laynam_jdbz (c_pps_chglay "HY_DL_JD_LAYER" "laysym" "laynam"))
	;;(mk_ly laynam_jdbz)
	(setq laynam_jdbz  "HY_DL_JD")
	(DL_MakeLayer laynam_jdbz)
	(setq	sca		(dl_getdrawingFactor)
				xh		t
				bht		""
				num		nil
				xwg		(/ 3.0 sca)
				r_cir	(/ 4.5 sca)
	)
	(while xh
		(setq ent (entsel "\n>>回车返回 / <选择要修改道路交点编号>:"))
		(if	(= ent nil)
			(setq xh nil)
			(progn
				(setq	ent	(car ent)
							wb	(entget ent '("RJDBH"))
				)
				(cond
					((not (and (assoc -3 wb) (= (cdr (assoc 0 wb)) "TEXT")))
					 (print)
					 (prompt "\n没选中道路交点编号,重选.")
					)
					(t
					 (setq stbh (cdr (assoc 1000 (cdadr (assoc -3 wb)))))
					 (if (= (entget (handent stbh)) nil)
						 (progn
							 (print)
							 (prompt "\n选中编号相关交点标志被删除,该编号已失效,重选."
							 )
						 )
						 (progn
							 (setq bh (&sljdbh (handent stbh)))
							 (HY_KZSJXZ ent nil 1 bh)
							 (HY_KZSJXZ (handent stbh) "RJCDBH" 1000 bh)
						 )
					 )
					)
				)
			)
		)
	)
	;;(mk_ly (c_pps_chglay "HY_SYS_COM_LAYER" "laysym" "laynam"))
	(DL_MakeLayer "PP-COM")
	(setvar "blipmode" 1)
	(setvar "cmdecho" 1)
	(princ)
)		
				;end of defun
					;
					;				
;;;
(defun #p_on_l(enb p / flag ptb n len ent eytpe)
  (setq n 0 len (length enb) flag t)
  (while (and flag (< n len)) 
    (setq ent (nth n enb)
          n (1+ n)
          etype (cdr (assoc 0 (entget ent)))
    )   
    (cond
      ((= etype "LINE")
        (setq ptb (bg-ypp ent))
        (if (pt_onl (car ptb) (cadr ptb) p)
          (setq flag nil)
        )
      )
      ((= etype "ARC")
        (if (pt_ona ent p)
          (setq flag nil)
        )
      )
      ((wcmatch etype "*POLYLINE")
        (if (pt_onpl ent p)
          (setq flag nil)
        )
      ) 
    )
  )
  (not flag)
)

;;;para: p or (list ent p)
(defun #get_zh(p / tmp p1 p2 zhb zh glb ent regn layc)
  (if (null #len_pe) (#ppls "Dim_pmbz"))
  ;;(setq layc  (c_pps_chglay "HY_DL_AXIS_LAYER" "laysym" "laynam"))
 	(setq layc  "Axis")
	(DL_MakeLayer laynam_jdbz)
  (SETQ GLB (list (cons 8 layc) 
                    '(-4 . "<or") 
                    '(0 . "LINE,*POLYLINE") 
                    '(0 . "ARC") 
                    '(-4 . "or>") 
                    '(-3 ("DLZH*"))
            )
        p (p# p)
  )
  (if (numberp (car p))
    (progn
      (setq ent (mentselps p 2.0 glb nil))
      (if ent (progn
        (while (and ent (not (#p_on_l (list ent) p)))
          (setq ent (mentselps p 2.0 glb ent))
        )
      ))
    )
    (progn
      (if (= (type (car p)) 'ENAME)
        (setq ent (car p) p (cadr p))
        (setq ent (cadr p) p (car p))
      )
    )
  )
  (if ent
    (setq tmp (#len_pe p ent)
          p1 (nth 3 tmp)
          p2 (nth 4 tmp)
          regn (#get_ern ent)
    )
  )
  (if regn (progn
    (setq zhb (dw-spp ent regn 1010))
    (cond
      ((equal p p1 0.01) (setq zh (car zhb)))
      ((equal p p2 0.01) (setq zh (cadr zhb)))
      (t
        (setq zh (/ (+ (* (car tmp)  (cadr zhb)) (* (cadr tmp)  (car zhb))) (caddr tmp) ))
        (if (equal zh 0.0 0.00001) (setq zh 0.0)) ;;;11:02  1998.12.21
      )
    )
  ))
  zh
)				
;;;
;;;
;;;
(defun #get_ern (ent / kzsj ret_v n)
  (caadr (assoc -3 (entget ent (list "DLZH*"))))
)
;;;
;;;

(defun pt_onpl(ent pt / plcsb len n flag pc an1 an2)
  (if (null &pl_en_cs) (#ppls"&@PP_ZXP.LSP"))
  (setq plcsb (&pl_en_cs ent) len (length plcsb) n 0 flag nil)
  (while (and (not flag) (< n len)) 
    (setq wb (nth n plcsb) n (1+ n))
    (if (= (car wb) "LINE")
      (setq flag (pt_onl (cadr wb) (caddr wb) pt))
      (progn
        (setq pc (cadr wb) an1 (nth 4 wb) an2 (nth 5 wb))
        (if (> (nth 8 wb) 0)  ;;;v42        
          (setq flag (pt_ona (list pc (nth 7 wb) an1 an2) pt)) 
          (setq flag (pt_ona (list pc (nth 7 wb) an2 an1) pt)) 
        )
   
      )
    )
  )
  flag 
)		
;;;
;;;

(defun tbxsxz (dclnam	sldlis	 zcuryh	  valdef   dcltt    sldnum
	       errstr	tcbz	 /	  dcl_id   curyh    curxsb
	       what	cursldh
	      )
  (setq	curyh	zcuryh
	curxsb	sldlis
	cursldh	valdef
  )
  (setq dcl_id (szdl_load_dlg dclnam))
  (if (not (new_dialog dclnam dcl_id))
    (exit)
  )
  (set_tile "dcltt" dcltt)

  (action_tile "accept" "(if (dcxzjc) (done_dialog 6))")
  (action_tile "cancel" "(done_dialog 0)")
  (action_tile
    "pre"
    "(if (>= curyh 2) (progn (errnil) (setq cursldh nil curyh (- curyh 1)) (bzsldxs)))"
  )
  (action_tile
    "nex"
    "(if (< (* curyh sldnum) (length curxsb)) (progn (errnil)(setq cursldh nil curyh (+ curyh 1)) (bzsldxs)))"
  )
  (bzsldxs)
  (if tcbz
    (mode_tile "cancel" 1)
  )
  (setq what (start_dialog))
  (unload_dialog dcl_id)
  (cond
    ((= what 0) nil)
    ((= what 6)
     (list curyh (+ cursldh (* (- curyh 1) sldnum)))
    )
  )
)					;end of defun
					;
					;
(defun bzsldxs (/ ns1 curxh xtbt x y xtbt cc)
  (if (= curyh 1)
    (mode_tile "pre" 1)
    (mode_tile "pre" 0)
  )
  (if (< (* curyh sldnum) (length curxsb))
    (mode_tile "nex" 0)
    (mode_tile "nex" 1)
  )
  (setq ns1 1)
  (repeat sldnum
    (setq cc (strcat "" (itoa ns1)))

;;;    (setq x (dimx_tile cc))
;;;    (setq y (dimy_tile cc))
;;;    (start_image cc)
    (setq curxh (+ (* (- curyh 1) sldnum) (- ns1 1)))
;;;    (fill_image 0 0 x y -2)
    (if	(<= (+ curxh 1) (length curxsb))
      (playsld (nth curxh curxsb) cc)
;;;      (slide_image
;;;	0
;;;	0
;;;	x
;;;	y
;;;	(strcat (HY_GetInstallDir) "sld/" (nth curxh curxsb))
    )
;;;    (end_image)
    (action_tile
      cc
      "(progn (errnil) (setq cursldh (atoi $key)))"
    )
    (setq ns1 (+ ns1 1))
  )
  (if cursldh
    (progn
      (setq curxh (+ cursldh (* (- curyh 1) sldnum)))
      (set_tile (strcat (itoa curxh)) "1")
    )
  )
)					;end of defun
					;
					;
(defun dcxzjc (/ zz)
  (setq zz "T")
  (cond
    ((or (= cursldh nil)
	 (> (+ (* (- curyh 1) sldnum) cursldh) (length curxsb))
     )
     (set_tile "error" errstr)
     (setq zz nil)
    )
  )
  zz
)					;end of defun
					;
					;


(princ)
						