;;
;;裁图线绘制和编辑 by 董冠军 $$

;;---------------------------[函数列表]----------------------**
;;执行函数:
;;	(draw_ctx)
;; 	(drag_ctx)
;;公用函数:
;;	($p_to_e        w_fprm  w_bprm  glb 512 )
;; 	(&pp_zxpx2      ent_zhx                 )
;; 	(&pp_tqzhpxb    ent_zhx                 )
;; 	(&cal_ptzh      pt      lst_zhx         )
;;  (zh_get_pde     zh      w_lnkb  w::prec )
;; 	(zhx_get_inter  ent     w_lnkb          )
;; 	(zhx_get_minmax lst_zhx                 )
;;  (lispx          lst                     )
;;辅助函数:
;; 	(ctx_draw_zh   lst_zhx   )
;; 	(ctx_draw_pick lst_zhx   )
;; 	(ctx_draw_auto lst_zhx   )
;; 	(ctx_draw_lin  zh w_lnkb )
;; 	(ctx_draw_vec  zh w_lnkb )
;;  (ctx_get_ezb   lst_ctx w_lnkb zh )
;;-----------------------------------------------------------**

;;
(defun   draw_ctx(/ glb w_fprm w_bprm w_sele ent_zhx lst_zhx w_lnkb loop str zhcode)
;;---------------------------[函数说明]----------------------**
;;函数功能: 绘制裁图线,提供了三种方式: 输入桩号/点取/自动绘制**
;;参数说明:
;;返 回 值: 无                                               **
;;备    注:
;;-----------------------------------------------------------**
	(hy_set0)
	
	;;(#ppls    "@hztk"   )
	;;(#ppls    "&pp_jbfy")
	(#ppls "pppp"  )
	(if (null &pp_zxpx2) 		 (#ppls "&@pp_zxp") )
	(if (null zhx_get_inter) (#ppls "pppp"		) )

	(setq glb '((-4 . "<or") (8 . "AXIS") (8 . "SW*") (-4 . "or>")
              (-4 . "<or") (-3 ("DLZH_*")) (-3 ("GDZH_*")) (-4 . "or>")) )
	(setq w_fprm "\n 回车退出 /点取要绘制裁图线的桩号线: " )
	(setq w_bprm "\n 请点取已定义桩号的道路中心线或管线: " )
	(setq w_sele ($p_to_e w_fprm w_bprm glb 512) )
	;;说明: w_sele -- (选中的桩号线 选取点), 否则，nil$$
	(if (= w_sele nil)
		(prompt "\n 图面没有或没选择桩号线." )
		(progn
			(setq ent_zhx (car w_sele) )
			(setq zhcode (caadr (assoc -3 (entget ent_zhx (list "DLZH_*")))))
			(setq zhcode (substr zhcode 6 (- (strlen zhcode) 5)))
			(setq lst_zhx (&pp_zxpx2   ent_zhx) )
			(setq w_lnkb  (&pp_tqzhpxb ent_zhx) )
			(if (= lst_zhx nil )
				(prompt "\n 桩号数据没有定义." )
				(progn
					(setq loop t )
					(while loop
						(setq str (getstring "\n 退出E /输入桩号Z /点取D /<自动绘制>: ") )
						(setq str (strcase str) )
						(cond
							((= str "E") (setq loop nil               ) )
							((= str "Z") (ctx_draw_zh  zhcode  lst_zhx w_lnkb) )
							((= str "D") (ctx_draw_pick lst_zhx w_lnkb) )
							((= str "" ) (ctx_draw_auto zhcode lst_zhx w_lnkb) )
							(t      (prompt "\n 警告: 输入无效!") )
						)						
					) ;while (not isvalid)
				)
			)	;if (= lst_zhx nil)
		)
	) ;if (= w_sele nil)

	;;(tocom )
	(hy_set1)	
	(princ)
)
;;
;;
(defun ctx_draw_zh (zhcode lst_zhx w_lnkb / tt str zh zh_min zh_max isvalid count strMin strMax strZh)
;;---------------------------[函数说明]----------------------**
;;函数功能: 输入桩号方式绘制裁图线                           **
;;参数说明:
;;返 回 值: 无                                               **
;;备    注:
;;-----------------------------------------------------------**
	
	(setq tt     (zhx_get_minmax lst_zhx) )
	(setq zh_min (car tt) zh_max (cadr tt) )
	
	;;(setq tt     (strcat "(" (rtos zh_min 2 1) " ～ " (rtos zh_max 2 1) ")") )
	(setq strMin (DL_GetBcStake zhcode zh_min)
	      strMax (DL_GetBcStake zhcode zh_max)
	)

	(if (= strMin nil) (setq strMin (rtos zh_min 2 1)))
	(if (= strMax nil) (setq strMax (rtos zh_max 2 1)))
	(setq tt     (strcat "(" strMin " ～ " strMax ")" ))
	(setq isvalid nil count 0 )
	(while (not isvalid)
		(if (= count 0)
			(setq str (strcat "\n 空格或回车返回 /输入要绘制裁图线的桩号" tt ": ") )
			(setq str (strcat "\n 空格或回车返回 /输入下一桩号" tt ": ") )
		)
		
		;;(setq zh (getreal str) )
		(setq strZh (getstring str))
		(setq zh (DL_GetRealStake zhcode strZh))
		(cond
			((=  zh nil )       (setq isvalid t) )
			((or (<  zh zh_min) (>= zh zh_max))
			 (prompt "\n 警告: 输入无效!")
			)
			(t
			 (ctx_draw_lin zh w_lnkb )
			 (setq count (+ count 1) )
			)
		) ;cond
  ) ;while (not isvalid)
	(princ)
)
;;
;;
(defun ctx_draw_pick ( lst_zhx w_lnkb / isvalid count str zh  pt )
;;---------------------------[函数说明]----------------------**
;;函数功能: 点取方式绘制裁图线                               **
;;参数说明:
;;返 回 值: 无                                               **
;;备    注:
;;-----------------------------------------------------------**
	(setq isvalid nil count 0 )
	(while (not isvalid)
		(if (= count 0)
			(setq str "\n 空格或回车返回 /点取一点:"   )
			(setq str "\n 空格或回车返回 /点取下一点:" )			
		) ;if
		
		(setq pt (getpoint str) )
		(if pt
			(progn				
				(if (setq zh (&cal_ptzh pt lst_zhx ) )
					(progn
						(ctx_draw_lin zh w_lnkb )
						(setq count  (+ count 1) )
					)
					(prompt "\n 警告: 点无效!" )
				) ;if zh
		  )
			(setq isvalid t)
		) ;if pt
  ) ;while (not isvalid)
	(princ)
)
;;
;;
(defun ctx_draw_auto (zhcode lst_zhx w_lnkb / tt zh zh_min zh_max zh_beg zh_diff lst_zh isvalid  strMin strMax strZh)
;;---------------------------[函数说明]----------------------**
;;函数功能: 自动绘制裁图线                                   **
;;参数说明:
;;返 回 值: 无                                               **
;;备    注:
;;-----------------------------------------------------------**
	
	(setq tt     (zhx_get_minmax lst_zhx ) )
	(setq zh_min (car  tt) zh_max (cadr tt) )
	;;(setq tt     (strcat "(" (rtos zh_min 2 1) " ～ " (rtos zh_max 2 1) ")") )
	(setq strMin (DL_GetBcStake zhcode zh_min)
	      strMax (DL_GetBcStake zhcode zh_max)
	)

	(if (= strMin nil) (setq strMin (rtos zh_min 2 1)))
	(if (= strMax nil) (setq strMax (rtos zh_max 2 1)))
	(setq tt     (strcat "(" strMin " ～ " strMax ")" ))
	
	(setq isvalid nil )
  (while (not isvalid)
		(setq isvalid t )
		;;;(setq zh_beg (getreal (strcat "\n 输入起始桩号" tt "<" (rtos zh_min 2 1) ">: ")) )
		(setq zh_beg (getstring (strcat "\n 输入起始桩号" tt "<" strMin ">: ")) )
		(setq strZh zh_beg)
		(setq zh_beg (DL_GetRealStake zhcode strZh))
		(cond
			((=  zh_beg nil   ) (setq zh_beg zh_min) )
			((<  zh_beg zh_min) (setq zh_beg zh_min) )
			((>= zh_beg zh_max)
			 (prompt "\n 警告: 输入无效!" )
			 (setq isvalid nil )
			)
		) ;cond
  ) ;while (not isvalid)

	(initget 6)
	(setq zh_diff (getreal (strcat "\n 输入每幅分图上的桩号数<200.0>: " )) )
	(if (null zh_diff) (setq zh_diff 200.0) )

	(setq zh zh_beg lst_zh nil)
	(while (< zh zh_max)
		(setq lst_zh (append lst_zh (list zh)) )
		(setq zh 		 (+ zh zh_diff) )
	)
	(setq lst_zh (append lst_zh (list zh_max)) )
	(if lst_zh (foreach zh lst_zh (ctx_draw_lin zh w_lnkb)) )
	(princ)
)
;;
;;
(defun drag_ctx (/ glb ent_ctx ss_ctx ent_zhx ss_stake
								   ret lx ii isvalid loop isfirst isselected count elem
								 	 lst_zhx w_lnkb lst lst_ctx lst_zh lst_zh_next lst_zh_diff
								   pt pt_int pt_curr pt_next
								   zh zh_min zh_max zh_curr zh_next zh_dest zhcode strZh strZh_dest
								)
;;---------------------------[函数说明]----------------------**
;;函数功能: 编辑裁图线，有三种方式:拖放/点取/输入桩号        **
;;参数说明:
;;返 回 值: 无                                               **
;;备    注: 基本思路是先确定第一条裁图线相应的桩号，据此计算 **
;;          出其后续裁图线的桩号，然后重绘                   **
;;-----------------------------------------------------------**
	(hy_set0)

	;;(ls    "@hztk"   )
	;;(ls    "&pp_jbfy")
	(#ppls "pppp"  )
	(if (null &pp_zxpx2)      (#ppls "&@pp_zxp") )
	(if (null zh_get_dimcfg)  (#ppls "hy_dlzh" ) )
        (zh_get_dimcfg)
	(setq isselected nil )
	(while (not isselected) 
		;; 选择要拖动的起始裁图线$
		(setq glb (list '(0 . "LINE") '(8 . "hy-ctx")) )
		(setq ret (gpsseld  glb "\n 回车或空格退出 /选择要定位的第一条裁图线: " nil) )
		(if ret	(progn
			(setq ent_ctx (car ret) pt_curr (cadr ret) )

			;; 搜索与其相交的道路中心线$
			(setq glb '((-4 . "<or") (8 . "AXIS") (8 . "SW*") (-4 . "or>")
		              (-4 . "<or") (-3 ("DLZH_*")) (-3 ("GDZH_*")) (-4 . "or>")) ) 
			(setq ss_stake (ssget "X" glb) )
			(if ss_stake (progn
				(setq ii 0 pt_int nil )
				(while (and (not pt_int) (< ii (sslength ss_stake)))
					(setq ent_zhx (ssname ss_stake ii ) )

					(setq w_lnkb  (&pp_tqzhpxb ent_zhx) )

					(setq pt_int 	(zhx_get_inter ent_ctx w_lnkb) )

			 		(setq ii 			(+ ii 1) )
			  ) ;while (and (not isvalid) (< ii (sslength ss_stake)))

				(if (and pt_int (setq lst_zhx (&pp_zxpx2 ent_zhx)))
					(progn
					    (setq zhcode (caadr (assoc -3 (entget ent_zhx (list "DLZH_*")))))
				        (setq zhcode (substr zhcode 6 (- (strlen zhcode) 5)))
						(setq lst (zhx_get_minmax lst_zhx) )
						(setq zh_min (car lst) zh_max (cadr lst) )
						
						;; 求取其后续裁图线$
						(setq zh_curr (&cal_ptzh pt_int lst_zhx) )
						(setq lst     (ctx_get_ezb lst_zhx w_lnkb zh_curr) ) 
						(setq lst_ctx nil lst_zh nil )
						(if lst       (foreach elem lst
														(setq lst_ctx (append lst_ctx (list (car  elem))) )
														(setq lst_zh  (append lst_zh  (list (cadr elem))) )
													) ;foreach
						) ;if lst
						(setq lst_zh_diff nil)
						(if lst_zh
							(setq lst_zh_diff (mapcar '(lambda (zh) (setq zh (- zh zh_curr))) lst_zh)) )
						
						(setq strZh (DL_GetBCStake zhcode zh_curr))
						(if (= strZh nil) (setq strZh (rtos zh_curr 2 1)))
						
						;;选择操作模式$
						(setq isvalid nil )
						(while (not isvalid)
							(initget "T D" )
							(setq zh_dest (getstring (strcat "\n 拖动定位T /点取D /输入目标桩号<"
																		 strZh ">: ")) )
						;;	(setq zh_dest (getreal (strcat "\n 拖动定位T /点取D /输入目标桩号<"
						;;												 (rtos zh_curr 2 1) ">: ")) )
																						
							(cond
								((= zh_dest nil ) (setq isvalid t) ) ;空格或回车返回$
								((or (= zh_dest "T" ) (= zh_dest "t" ))
								 ;; ---------------------
								 (setq loop t isfirst t )
								 (while loop
									 (setq ret (grread t 4 2) )
									 (setq lx (car  ret) pt_next (cadr ret) )
									 
								 ;; 进入拖动模式$
									 (if (and (= lx 5) (not (equal pt_curr pt_next)))
										 (progn
											 ;; 移动第一条裁图线$
											 (command "_.MOVE" ent_ctx "" pt_curr pt_next )
											 (setq pt_curr pt_next )

											 (setq pt_int (zhx_get_inter ent_ctx w_lnkb) )
											 ;; 如果第一条裁图线与桩号线有交点，则：$

									     (if pt_int	(progn
												 (setq zh_next (&cal_ptzh pt_int lst_zhx) )

												 (if (/= (- zh_next zh_curr) 0.0 )
													 (progn
														 ;; 重绘第一条裁图线$
														 (entdel ent_ctx)
														 (ctx_draw_lin zh_next w_lnkb)
														 (setq ent_ctx (entlast) )
														 ;; 处理其后续裁线$
														 ;; 更新桩号列表$
														 (setq lst_zh_next (mapcar '(lambda (zh) (setq zh (+ zh_next zh))) lst_zh_diff) )
											 
														(if isfirst
															(progn
																(foreach elem lst_ctx   (entdel elem) )
																(foreach zh lst_zh_next (ctx_draw_vec zh w_lnkb) )
																(setq isfirst nil )
															)
															(progn
																(foreach zh lst_zh      (ctx_draw_vec zh w_lnkb) )
																(foreach zh lst_zh_next (ctx_draw_vec zh w_lnkb) )
															)
														) ;if first
														 (setq zh_curr zh_next lst_zh lst_zh_next )
													 )
												 ) ; if (/= (- zh_next zh_curr) 0.0)
											 )) ;if pt_int
										 )
									 ) ;if (and (= lx 5) (not (equal pt_curr pt_next)) )
									 
								
									 ;; 当第一条裁图线与桩号线有交点时, 按键或点取退去拖动模式$
									 (if (or (= lx 2) (= lx 3))
										 (progn
											 (setq pt_int (zhx_get_inter ent_ctx w_lnkb) )
											 (if pt_int
												 (progn
													 (setq loop nil ) ;; 退出循环$
													 (if lst_zh_diff
														 (progn
															(redraw)
															(setq zh_curr (&cal_ptzh pt_int lst_zhx) )
															(setq lst_zh  (mapcar '(lambda (zh) (setq zh (+ zh_curr zh))) lst_zh_diff) )
															(setq ii 0 )
															(foreach zh lst_zh (if (ctx_draw_lin zh w_lnkb) (setq ii (+ ii 1))) )															 
															(if (< ii (length lst_zh)) (ctx_draw_lin zh_max w_lnkb) )
															)
													 ) ;if lst_zh_diff
												 )
												 (prompt "\n 警告: 裁图线与道路中心线无交点, 继续拖动!!!")
											 ) ;if pt_int
										 )
									 ) ;if (or (= lx 2) (= lx 3))
								 ) ;while loop
								 ;; ---------------------
								 (setq isvalid t )
								)								
								((or (= zh_dest "D" ) (= zh_dest "d" ))
								 (setq count 0 loop t )
								 (while loop
									 (if (= count 0)
										 (setq str "\n 空格或回车返回 /点取一点: " )
										 (setq str "\n 空格或回车返回 /重新点取一点: " )
									 )
									 (setq count (+ count 1) )
										 
									 (setq pt (getpoint str) )
									 (if pt
										 (progn
											 (setq zh_dest (&cal_ptzh pt lst_zhx ) )
											 (if zh_dest (progn
												 (entdel ent_ctx)
												 (ctx_draw_lin zh_dest w_lnkb )
												 
												(foreach elem lst_ctx (entdel elem) )
												(setq lst_zh (mapcar '(lambda (zh) (setq zh (+ zh_dest zh))) lst_zh_diff) )
												(setq ii 0)
												(foreach zh lst_zh (if (ctx_draw_lin zh w_lnkb) (setq ii (+ ii 1))) )
												(if (< ii (length lst_zh)) (ctx_draw_lin zh_max w_lnkb) )
												(setq loop nil isvalid t )
												 ) (prompt "\n 警告: 点无效!" )
											 ) ;if zh_dest
										 ) (setq loop nil )
									 ) ;if pt
								 ) ;loop
								)
								(t
								 (setq strZh_dest zh_dest)
								 (setq zh_dest (DL_GetRealStake zhcode strZh_dest))
								 (if (and (/= zh_dest nil) (>= zh_dest zh_min) (<= zh_dest zh_max))
								 	 (progn
										 (entdel ent_ctx )
										 (ctx_draw_lin zh_dest w_lnkb )
										 
										 (if lst_zh_diff
											 (progn	
												(foreach elem lst_ctx (entdel elem) )
												(setq lst_zh (mapcar '(lambda (zh) (setq zh (+ zh_dest zh))) lst_zh_diff) )
												(setq ii 0)
												(foreach zh lst_zh (if (ctx_draw_lin zh w_lnkb) (setq ii (+ ii 1))) )
												(if (< ii (length lst_zh)) (ctx_draw_lin zh_max w_lnkb) ) 
												)
										 ) ; lst_zh_diff
										 (setq isvalid t )
									 )
									 (prompt "\n 警告: 输入无效!" )
								 ) ;if (and (>= zh_dest zh_min) (< zh_dest zh_max))
								) ;t
							) ;cond
						) ;while (not isvalid)
						;;
						;;
					)
					(prompt "\n 警告: 所选裁图线与道路中心线没有交点!" )
				) ; if (and isvalid (setq lst_zhx (&pp_zxpx2 ent_zhx)))
				)	(prompt "\n 警告: 当前图面没有定义道路中心线!" )
			) ;if ss_stake
			)	(setq isselected t)
		) ;if ret
	) ;while isselected
	
	(hy_set1)
	(zh_nil_dimcfg)
	(princ)
)
;;
;;
(defun ctx_get_ezb ( lst_zhx w_lnkb zh_curr / glb ss_ctx ent_ctx zh lst_ctx_zh ii pt  )
;;---------------------------[函数说明]----------------------**
;;函数功能: 得到桩号线上桩号大于给定桩号的裁图线的实体桩号表 **
;;参数说明:
;;返 回 值: ((ent1 zh1) ...); 若无, nil                      **
;;备    注:
;;-----------------------------------------------------------**
	
	(setq glb    (list '(0 . "LINE") '(8 . "hy-ctx")) )
	(setq ss_ctx (ssget "X" glb) lst_ctx_zh nil )
	(if ss_ctx
		(progn
			(setq ii 0 )
			(repeat (sslength ss_ctx)
				;; 求该剪裁线与道路中心线的交点, 若无, 忽略该剪裁线$
				(setq ent_ctx (ssname ss_ctx ii) )
				(setq pt 			(zhx_get_inter ent_ctx w_lnkb) )
				
				;; 由交点反求桩号, 若对应桩号 > 给定桩号，把该裁图线加入结果中$
				(if pt
					(progn
						(setq zh (&cal_ptzh pt lst_zhx) )
						(if (> zh zh_curr) (setq lst_ctx_zh (append lst_ctx_zh (list (list ent_ctx zh)))) )
					)
				) ;if pt
				(setq ii (+ ii 1) )
			)	;repeat (sslength ss_ctx)
			(setq lst_ctx_zh (lispx lst_ctx_zh) ) ;按桩号从小到大排序$
		) 
	) ;if ss_all
	lst_ctx_zh
)
;;
;;
(defun ctx_draw_lin ( zh w_lnkb / width lst pt ang pt_beg pt_end isvalid ent_data )
;;---------------------------[函数说明]----------------------**
;;函数功能: 在一定图层上绘制对应给定桩号的裁图线             **
;;参数说明:
;;返 回 值: 若绘制成功，t; 否则，nil                         **
;;备    注:
;;-----------------------------------------------------------**
(zh_get_dimcfg)
	(setq lay_ctx "hy-ctx" width 100.0 isvalid t )
	(setq lst (zh_get_pde zh w_lnkb w::prec) ) ;(pt ang ent)
	(if (/= lst nil)
		(progn
			(if (null (tblsearch "LAYER" lay_ctx)) (command "-LAYER" "N" lay_ctx "") )
			(setq pt (car lst ) ang (cadr lst) )
			(setq pt_beg (polar pt (- ang (* 0.5 pi)) width) )
			(setq pt_end (polar pt (+ ang (* 0.5 pi)) width) )
			(command "_.LINE" pt_beg pt_end "" )
		
			(setq ent_data (entget (entlast)) )
			(setq ent_data (subst (cons 8 lay_ctx) (assoc 8 ent_data) ent_data) )
			(entmod ent_data )
		)
		(setq isvalid nil)
	) ;if (/= lst nil)
	(zh_nil_dimcfg)
	isvalid
)
;;
;;
(defun ctx_draw_vec ( zh w_lnkb / width lst pt ang pt_beg pt_end )
;;---------------------------[函数说明]----------------------**
;;函数功能: 绘制对应给定桩号的矢量线                         **
;;参数说明:
;;返 回 值: 无                                               **
;;备    注: 服务于拖放模式                                   **
;;-----------------------------------------------------------**
(zh_get_dimcfg)
	(setq width 100.0 )
	(setq lst (zh_get_pde zh w_lnkb w::prec) ) ;(pt ang ent)
	(if (/= lst nil)
		(progn
			(setq pt (car lst ) ang (cadr lst) )
			(setq pt_beg (polar pt (- ang (* 0.5 pi)) width) )
			(setq pt_end (polar pt (+ ang (* 0.5 pi)) width) )
			(grdraw pt_beg pt_end -1 )
		)
	) ;if (/= lst nil)
	(zh_nil_dimcfg)
	(princ)
)
;;
;;
(princ)