;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun pm_ptb_ip (xc_p1	xc_p2 xc_ptb / w_ii w_len w_sp w_ep w_retp
		  w_retpb)
  (setq	w_ii	1
	w_len	(length xc_ptb)
	w_retpb	'()
  )
  (while (< w_ii w_len)
    (setq w_sp (nth (- w_ii 1) xc_ptb)
	  w_ep (nth w_ii xc_ptb)
    )
    (setq w_ii (1+ w_ii))
    (if	(setq w_retp (inters xc_p1 xc_p2 w_sp w_ep))
      (setq w_retpb (cons w_retp w_retpb))
    )
  )
  w_retpb
)
(defun pm_zbwg (/	   w_in_fun   w_off_dist w_pll	    w_loop
		w_prr	   w_ang      w_dist	 w_wgfs	    w_crl
		w_tksc	   w_tkname   w_angr	 w_pi05	    w_ptl
		w_pbr	   w_frm_ptb  w_max_dist w_midp	    w_xy_midp
		w_xy_x	   w_xy_y     w_xy_ix	 w_xy_iy    w_xy_ip
		w_ip	   w_goon     w_basp	 w_yd_ptb   w_basx
		w_left_p   w_right_p  w_frmp	 w_xd_ptb   w_basy
		w_old_layer	      w_ss_del	 w_yd_pt    w_yd_spt
		w_yd_ept   w_xd_pt    w_xd_spt	 w_xd_ept   w_insp
		w_cross_l  w_pt1      w_pt2	 w_pt3	    w_pt4
		w_ang_n
	       )
  (defun w_in_fun (xc_elem)
    (setq wp1 (p# (cadr xc_elem))
	  wp2 (p# (caddr xc_elem))
    )
    (list wp1 wp2)
  )

  (szload pub_save_var "wwpublic")
  (pub_save_var)
;;;得到对角点和网格间距w_pll--w_prr--w_off_dist
  (while (< (if	(setq w_off_dist (getint "\n输入网格间距<50m>:"))
	      w_off_dist
	      (setq w_off_dist 50.0)
	    )
	    1
	 )
    (prompt "\n网格间距必须为大于零的整数")
  )
  (setq w_pll (getpoint "\n输入网格左下角<0,0>:"))
  (if (null w_pll)
    (setq w_pll (list 0.0 0.0 0.0))
  )
  (setq w_loop t)
  (while w_loop
    (setq w_prr (getcorner w_pll "\n回车退出 / 输入网格右上角:"))
    (if	(null w_prr)
      (setq w_loop nil)
    )
    (if	w_prr
      (progn
	(setq w_ang (angle w_pll w_prr))
	(if (> w_ang (* pi 0.5))
	  (progn
	    (prompt "\n请点取网格右上角:")
	    (setq w_prr nil)
	  )
	)
      )
    )
    (if	w_prr
      (progn
	(setq w_dist (pmdist w_pll w_prr))
	(if (< w_dist w_off_dist)
	  (progn
	    (prompt "\n两点间的间距不足一个网格，请重输!")
	    (setq w_prr nil)
	  )
	)
	(setq w_loop nil)
      )
    )
  )
  (if w_prr
    (progn
      (initget "W")
      (setq
	w_wgfs (getkword "\n选择坐标网格方式: 网状 W / <回车十字>:")
      )
      (if (null w_wgfs)
	(progn
	  (setq w_crl (getreal "\n图面十字线长度(mm)<20.0>:"))
	  (if (null w_crl)
	    (setq w_crl 20.0)
	  )
	  (setq w_cross_l (/ w_crl (DL_GetDrawingFactor)))
;;;					(setq w_tksc (/ w_crl 20.0 (DL_GetDrawingFactor)))
;;;					(setq w_tkname (strcat (HY_GetInstallDir) "dwg\\zb_cross"))
	)
      )

;;;北方向与零度的夹角
      (setq w_ang_n (HY_GetNorthDirection)
	    w_angr  (dtor w_ang_n)
	    w_pi05  (* 0.5 pi)
      )
      (setq w_ptl     (list (car w_pll) (cadr w_prr) 0.0)
	    w_pbr     (list (car w_prr) (cadr w_pll) 0.0)
	    w_frm_ptb (list w_pll w_pbr w_prr w_ptl w_pll)
      )
      (setq w_max_dist (pmdist w_pll w_prr))
      (setq w_midp (midpt w_pll w_prr))
      (setq w_xy_midp (HY_TransCoord w_midp 0)
	    w_xy_x    (car w_xy_midp)
	    w_xy_y    (cadr w_xy_midp)
	    w_xy_ix   (- w_xy_x (rem w_xy_x w_off_dist))
	    w_xy_iy   (- w_xy_y (rem w_xy_y w_off_dist))
	    w_xy_ip   (list w_xy_ix w_xy_iy 0.0)
	    w_ip      (HY_TransCoord w_xy_ip 1)
      )
;;;求X正方向坐标线的端点表
      (setq w_goon t
	    w_basp w_ip
	    w_yd_ptb '()
	    w_basx w_xy_ix		;坐标X值
      )
      (while w_goon
	(setq w_left_p	(polar w_basp (+ w_angr w_pi05) w_max_dist)
	      w_right_p	(polar w_basp (- w_angr w_pi05) w_max_dist)
	      w_frmp	(pm_ptb_ip w_left_p w_right_p w_frm_ptb)
	)

	(if w_frmp
	  (setq	w_yd_ptb (cons (cons w_basx w_frmp) w_yd_ptb)
		w_basp	 (polar w_basp w_angr w_off_dist)
		w_basx	 (+ w_basx w_off_dist)
	  )
	  (setq w_goon nil)
	)
      )
;;;end of (while w_goon
;;;求X负方向坐标线的端点表
      (setq w_goon t
	    w_basp (polar w_ip (+ pi w_angr) w_off_dist)
	    w_basx (- w_xy_ix w_off_dist) ;坐标X值
      )
      (while w_goon
	(setq w_left_p	(polar w_basp (+ w_angr w_pi05) w_max_dist)
	      w_right_p	(polar w_basp (- w_angr w_pi05) w_max_dist)
	      w_frmp	(pm_ptb_ip w_left_p w_right_p w_frm_ptb)
	)

	(if w_frmp
	  (setq	w_yd_ptb (cons (cons w_basx w_frmp) w_yd_ptb)
		w_basp	 (polar w_basp (+ pi w_angr) w_off_dist)
		w_basx	 (- w_basx w_off_dist)
	  )
	  (setq w_goon nil)
	)
      )
;;;end of (while w_goon
;;;求Y正方向坐标线的端点表
      (setq w_goon t
	    w_basp w_ip
	    w_xd_ptb '()
	    w_basy w_xy_iy		;坐标Y值
      )
      (while w_goon
	(setq w_left_p	(polar w_basp w_angr w_max_dist)
	      w_right_p	(polar w_basp (+ w_angr pi) w_max_dist)
	      w_frmp	(pm_ptb_ip w_left_p w_right_p w_frm_ptb)
	)

	(if w_frmp
	  (setq	w_xd_ptb (cons (cons w_basy w_frmp) w_xd_ptb)
		w_basp	 (polar w_basp (- w_angr w_pi05) w_off_dist)
		w_basy	 (+ w_basy w_off_dist)
	  )
	  (setq w_goon nil)
	)
      )
;;;end of (while w_goon
;;;求Y负方向坐标线的端点表
      (setq w_goon t
	    w_basp (polar w_ip (+ w_angr w_pi05) w_off_dist)
	    w_basy (- w_xy_iy w_off_dist) ;坐标X值
      )
     (while w_goon
	(setq w_left_p	(polar w_basp w_angr w_max_dist)
	      w_right_p	(polar w_basp (+ w_angr pi) w_max_dist)
	      w_frmp	(pm_ptb_ip w_left_p w_right_p w_frm_ptb)
	)

	(if w_frmp
	  (setq	w_xd_ptb (cons (cons w_basy w_frmp) w_xd_ptb)
		w_basp	 (polar w_basp (+ w_angr w_pi05) w_off_dist)
		w_basy	 (- w_basy w_off_dist)
	  )
	  (setq w_goon nil)
	)
      )

;;;end of (while w_goon
;;;w_yd_ptb--与Y轴平行的坐标线点表
;;;w_xd_ptb--与X轴平行的坐标线点表
      (HY_Set0)
      (setq w_old_layer (getvar "clayer"))
      (DL_MakeLayer "pp-pm-zbwg")
      (command "layer" "s" "pp-pm-zbwg" "")
      (setq w_ss_del (ssget "x" '((8 . "pp-pm-zbwg"))))
      (if w_ss_del
	(command "_.erase" w_ss_del "")
      )
      (setq w_ss_del nil)
      (if (null w_wgfs)
          (pm_dim_zbwg w_ang_n w_yd_ptb w_xd_ptb (* w_cross_l 0.5))
          (pm_dim_zbwg w_ang_n w_yd_ptb w_xd_ptb nil)
      )
     
      (setq w_yd_ptb (mapcar '(lambda (xc_e) (w_in_fun xc_e)) w_yd_ptb))
      (setq w_xd_ptb (mapcar '(lambda (xc_e) (w_in_fun xc_e)) w_xd_ptb))
      (if (null w_wgfs)
	(progn
	  (foreach w_yd_pt w_yd_ptb
	    (setq w_yd_spt (car w_yd_pt)
		  w_yd_ept (cadr w_yd_pt)
	    )
	    (foreach w_xd_pt w_xd_ptb
	      (setq w_xd_spt (car w_xd_pt)
		    w_xd_ept (cadr w_xd_pt)
	      )
	      (if (setq
		    w_insp (inters w_yd_spt w_yd_ept w_xd_spt w_xd_ept)
		  )
		(progn
		  (setq	w_pt1 (polar w_insp w_angr (* w_cross_l 0.5))
			w_pt2 (polar w_insp
				     (+ w_angr (* pi 0.5))
				     (* w_cross_l 0.5)
			      )
			w_pt3 (polar w_insp (+ w_angr pi) (* w_cross_l 0.5))
			w_pt4 (polar w_insp
				     (+ w_angr (* pi 1.5))
				     (* w_cross_l 0.5)
			      )
		  )
		  (command "_.line" w_pt1 w_pt3 "")
		  (command "_.line" w_pt2 w_pt4 "")
;;;								(command "_.copy" w_cross "" w_p000 w_insp)
		)
	      )
	    )
	  )
;;;					(command "_.erase" w_cross "")
	)
	(progn
;;;网状
	  (foreach w_yd_pt w_yd_ptb
	    (setq w_yd_spt (car w_yd_pt)
		  w_yd_ept (cadr w_yd_pt)
	    )
	    (command "_.line" w_yd_spt w_yd_ept "")
	  )
	  (foreach w_xd_pt w_xd_ptb
	    (setq w_xd_spt (car w_xd_pt)
		  w_xd_ept (cadr w_xd_pt)
	    )
	    (command "_.line" w_xd_spt w_xd_ept "")
	  )
	)
      )
      (setvar "clayer" w_old_layer)
      (HY_RV)
    )
  )
  (pub_re_var)
  (princ)
)

;;;任蔚青修改2003-7-30 10:48，增加传入参数txtoffset(标示坐标文字标注的偏移距离），十字坐标传入的是十字线长，而网格坐标传入的是nil
;;;为保证十字坐标的坐标标注不会标注在十字线上
(defun pm_dim_zbwg (xc_ang    xc_yd_ptb	xc_xd_ptb txtoffset / w_txh
		    w_sc      w_ang_xd	w_ang_yd  w_line_txtd
		    w_yd_pt   w_xv	w_p1	  w_p2	    w_ang
		    w_text    w_p11	w_p22	  w_xd_pt   w_yv
		   )
  (styrem)
  (setq	w_txh (Dl_GetTextHeight)
	w_sc  (DL_GetDrawingFactor)
	w_txh (/ w_txh w_sc)
  )
  (setq w_ang_xd xc_ang)
  (setq w_ang_yd (+ xc_ang 270))
  (setq w_ang_yd (rem w_ang_yd 360))
  
  
;;;;任蔚青修改2003-7-30 10:48
;;;;增加判断，十字坐标传入的是十字线长，而网格坐标传入的是nil
  (if  (null txtoffset)
       (if (null (setq w_line_txtd (DL_GetPrjVal "DIM_LINE_TXTD")))
            (setq w_line_txtd 2.0)
        )
        (setq w_line_txtd txtoffset)
  )




  (setq w_line_txtd (/ w_line_txtd w_sc))

  (foreach w_yd_pt xc_yd_ptb
    (setq w_xv	 (car w_yd_pt)
	  w_p1	 (cadr w_yd_pt)
	  w_p2	 (caddr w_yd_pt)
	  w_ang	 (angle w_p1 w_p2)
	  w_ang	 (rtod w_ang)
	  w_text (strcat "X " (itoa (fix w_xv)))
    )
  ;;;任蔚青修改判断条件2003-7-30 10:48,有时求出的w_ang是360.0,而w_ang_xd是0.0 
 ;;;(if	(equal w_ang w_ang_yd 0.1)
    (if (or (<= (abs (- w_ang  w_ang_yd)) 0.1) (<= (abs (- (abs (- w_ang  w_ang_yd)) 360.0)) 0.1))
      (progn
	(setq w_p11 (polar w_p1 (angle w_p2 w_p1) w_line_txtd))
	(command "_.text" "j" "mr" w_p11 w_txh w_ang_yd w_text)
	(setq w_p22 (polar w_p2 (angle w_p1 w_p2) w_line_txtd))
	(command "_.text" "j" "ml" w_p22 w_txh w_ang_yd w_text)
      )
      (progn
	(setq w_p11 (polar w_p1 (angle w_p2 w_p1) w_line_txtd))
	(command "_.text" "j" "ml" w_p11 w_txh w_ang_yd w_text)
	(setq w_p22 (polar w_p2 (angle w_p1 w_p2) w_line_txtd))
	(command "_.text" "j" "mr" w_p22 w_txh w_ang_yd w_text)
      )
    )
    
  )


  (foreach w_xd_pt xc_xd_ptb
    (setq w_yv	 (car w_xd_pt)
	  w_p1	 (cadr w_xd_pt)
	  w_p2	 (caddr w_xd_pt)
	  w_ang	 (angle w_p1 w_p2)
	  w_ang	 (rtod w_ang)
	  w_text (strcat "Y " (itoa (fix w_yv)))
    )
  
   ;;;任蔚青修改判断条件2003-7-30 10:48,有时求出的w_ang是360.0,而w_ang_xd是0.0 
   ;;;(if	(equal w_ang w_ang_xd 0.1)
      (if (or (<= (abs (- w_ang  w_ang_xd)) 0.1) (<= (abs (- (abs (- w_ang  w_ang_xd)) 360.0)) 0.1))
      (progn
	(setq w_p11 (polar w_p1 (angle w_p2 w_p1) w_line_txtd))
	(command "_.text" "j" "mr" w_p11 w_txh w_ang_xd w_text)
	(setq w_p22 (polar w_p2 (angle w_p1 w_p2) w_line_txtd))
	(command "_.text" "j" "ml" w_p22 w_txh w_ang_xd w_text)
      )
      (progn
	(setq w_p11 (polar w_p1 (angle w_p2 w_p1) w_line_txtd))
	(command "_.text" "j" "ml" w_p11 w_txh w_ang_xd w_text)
	(setq w_p22 (polar w_p2 (angle w_p1 w_p2) w_line_txtd))
	(command "_.text" "j" "mr" w_p22 w_txh w_ang_xd w_text)
      )
    )
  )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;任蔚青增加，将简单实体转成PLINE线．
;;;2004-5-25 16:11
(defun change_pline(ent / ent_obj pt_start pt_end)
 (if (= vlax-curve-getStartPoint nil) 
   (vl-load-com)
 )
 (setq ent_obj (vlax-ename->vla-object ent))
 (setq pt_start (vlax-curve-getStartPoint ent_obj) pt_end (vlax-curve-getEndPoint ent_obj))
 (if (and (/= pt_start nil) (/= pt_end nil) (= (caddr pt_start) (caddr pt_end)))
     (command "pedit" ent "" "")
 ) 
)
;;;在指定图层上插入指定图库中的图块 "三维人物"
(defun hysz_ins_tkk (xc_layer xc_tkname / w_tkm w_pt w_xscale w_yscale w_rang)
  (szload pub_save_var "wwpublic")
  (pub_save_var)
  (DL_ArxLoad "GalleryManage")
  (DL_MakeLayer xc_layer)
  (while (setq w_tkm (DL_ShowGallery xc_tkname))
    (if (null w_xscale)
      (setq w_xscale (getreal "\n X 方向比例<1.0>:"))
    )
    (if (null w_yscale)
      (setq w_yscale (getreal "\n Y 方向比例<1.0>:"))
    )
    (if (null w_rang)
      (setq w_rang (getreal "\n 旋转角<0.0>:"))
    )
    (if (null w_xscale)
      (setq w_xscale 1.0)
    )
    (if (null w_yscale)
      (setq w_yscale 1.0)
    )
    (if (null w_rang)
      (setq w_rang 0.0)
    )
    (while (setq w_pt (getpoint "\n 回车返回 / 点取插入点:"))
      (command "_.insert" w_tkm w_pt w_xscale w_yscale w_rang)
    )
  )
  (DL_MakeLayer "PP-COM")
  (pub_re_var)
  (princ)
)
;;;功能:转换图层设置的线宽、颜色和线型.
;;;程序名：hysztool.lsp
;;;主函数名：attribute_change
;;;算法流程描述：
;;;将当前图形文件中的直线和圆弧转换成多义直线，
;;;按设置的图层信息对文件中变换后的多义直线图元进行修改
;;;对当前图层圆图形各个图元分别进行线宽、颜色和线型处理;
;;;主要参数说明:ss2_c:当前图层中直线和圆弧实体集 ss1_c:当前图层中所有多义直线图元实体集
;;;xc_name 当前层名 xc_lc当前层颜色 xc_lw当前层线宽 xc_lt当前层线型
;;;调用方式：(attribute_change xc_name xc_lc xc_lw xc_lt)

(defun attribute_change	(xc_name xc_lc xc_lw xc_lt / ss2_c x2 ss1_c x1
			 number_ss2 select_ent x3 ss_circle att_circle
			 diam_circle cen_circle	number_ss1 select_ent1
			 number_ss select_ent2 filter1 filter2 filter3
			)
  (princ "\n 正在工作，请稍候......")
  (setq	ss2_c	nil
	filter1	(list (cons 8 xc_name) '(0 . "line,arc"))
  )
					;获取当前层的直线和圆弧图元集
  (setq ss2_c (ssget "x" filter1))
  (if (/= ss2_c nil)
					;判断直线和圆弧图元集是否是空集
    (progn
      (setq number_ss2
	     (sslength ss2_c)
	    x1 0
      )
      (while (< x1 number_ss2)
					;把直线和圆弧图元转换成多义直线
        (&wait_bz)
	(setq select_ent (ssname ss2_c x1))
	;;;(command "pedit" select_ent "" "")
	(change_pline select_ent)
	(setq x1 (1+ x1))
      )
    )
  )
  (setq filter2 (list (cons 8 xc_name) '(0 . "lwpolyline,polyline")))
  (setq ss1_c (ssget "x" filter2))
					;获取当前层的多义直线图元集
  (if (/= ss1_c nil)
    (progn
      (setq number_ss1
	     (sslength ss1_c)
	    x2 0
      )

      (while (< x2 number_ss1)
        (&wait_bz)
        
        
	(setq select_ent1 (ssname ss1_c x2))
	(if (and (null (assoc 71 (entget select_ent1)));;;只处理简单PLINE线,过滤出polyface,polygon等
	         (null (assoc 72 (entget select_ent1)))
	    )
	    (command "pedit" select_ent1 "w" xc_lw "")
	)

	(setq x2 (1+ x2))

      )
					;将当前层的图元按用户设置的线宽重新绘制
      (command "chprop" ss1_c "" "c" xc_lc "lt" xc_lt "")
					;按用户设置改变颜色和线型
    )
  )
  (setq filter3 (list (cons 8 xc_name) '(0 . "circle")))
  (setq ss_circle (ssget "x" filter3))	;获取当前层的圆图元集
  (if (/= ss_circle nil)		;判断圆图元集是否为空并处理
    (progn (setq number_ss
		  (sslength ss_circle)
		 x3 0
	   )
	   (while (< x3 number_ss)	;对圆图元集各个图元进行线宽处理
             (&wait_bz)
	     (setq select_ent2 (ssname ss_circle x3))
	     (setq att_circle (entget select_ent2))
	     (setq cen_circle  (cdr (assoc 10 att_circle))
		   diam_circle (* (cdr (assoc 40 att_circle)) 2)
	     )
	     (command "donut"
		      (- diam_circle xc_lw)
		      (+ diam_circle xc_lw)
		      cen_circle
		      ""
	     )
	     (setq x3 (1+ x3))
	   )
	   (command "chprop" ss_circle "" "c" xc_lc "lt" xc_lt "")
					;对圆图元集各个图元进行颜色和线型处理
    )
  )
  (princ "\n 正在工作，请稍候.........OK!")
)
;;;功能:用于把图面实体转换成图层设置的线宽、颜色和线型，另存一个图形文件。
;;;程序名：hysztool.lsp
;;;主函数名：dwg_perproc
;;;算法流程描述：对用户提出警告，调用公用函数取得当前工程目录(DL_GetCurPrjDir)，
;;;;作为缺省的存放目录
;;;首先逐层提取并显示当前的图形文件信息（线宽、颜色和线型），如果用户要修改当前信息
;;;则调入(attribute_change xc_name xc_lc xc_lw xc_lt)函数提示用户输入图形信息并修改；
;;;如果用户修改了当前信息将最终结果存成文件，并指明路径及文件名称。
;;;主要参数：path :当前工作目录 ss2:用户选中的实体集 pfname: 出预处理文件名
;;;ly_lc ly_lt ly_lw ly_name分别为当前图层的颜色、线型、线宽和名称
;;;调用方式：(dwg_preproc)
(defun dwg_preproc (/ k1 x1 x2 path pfname ss2 ly_name ly_lc ly_lt ly_lw w_sca)
  (DL_MsgOK "该操作具有潜在的危险性，请备份您的图形!")
  (szload pub_save_var "wwpublic")
  (pub_save_var)
  ;;给用户提示信息
  
  (setq path (DL_GetCurPrjDir))
  (if (null path) 
  (progn
    (setq path (HY_getworkdir))
    (if path (setq path (substr path 1 (- (strlen path) 2))))
  )
 )
  ;;获取当前工作目录
  (setq pfname (getfiled "预处理过的图形保存在..." path "dwg" 1))
  (setq k1 1 w_sca (DL_GetDrawingFactor))
  (if pfname
    (progn
      (HY_UndoM)
      (while (setq b1 (tblnext "layer" k1))
	;;循环提取各层层名等信息，并该层进行有关操作
	(setq k1      nil
	      ly_name (strcase(cdr (assoc 2 b1)))
		      ;;获取当前层层名
	)
	(setq ly_lc (DL_GetLayerColor ly_name)
	      ;;获取当前层颜色
	      ly_lt (DL_GetLayerLinetype ly_name)
	      ;;获取当前层线型
	      ly_lw (DL_GetLayerLineWidth ly_name)
		    ;;获取当前层线宽
	)
	(if (and ly_lc ly_lt ly_lw)
	  (attribute_change ly_name ly_lc (/ ly_lw w_sca) ly_lt)
	)
	;;调入(attribute_change xc_name xc_lc xc_lw xc_lt)进行处理
      )					;while end
      (setq ss2 (ssget "x"))
      (if (findfile pfname)
	(command "wblock" pfname "y" "" "0,0" ss2 "")
	(command "wblock" pfname "" "0,0" ss2 "")
      )
      (HY_UndoB)
      (DL_MsgOK
	(strcat	"该图预处理成功完成!\n\n处理后的图形保存在 <"
		(strcase pfname) "> 中!"
	)
      )
    )
  )
  (pub_save_var)
  (princ)
)
;;;功能:把用户选中的图形实体另存一个图形文件。
;;;程序名：hysztool.lsp
;;;主函数名：dwg_output
;;;算法流程描述：调用公用函数取得当前工程目录(DL_GetCurPrjDir)，作为缺省的存放目录
;;;;让用户选择图形实体，如果用户选中实体则弹出浏览话框,
;;;让用户选择图形实体文件的路径及文件名并返回。
;;;将用户选中的实体存成文件，并指明路径及文件名称。
;;;path :当前工作目录 ss1:用户选中的实体集 pfname: 图形实体文件名
;;;调用方式：(dwg_output)
(defun dwg_output (/ path ss1 pfname)
  (szload pub_save_var "wwpublic")
  (pub_save_var)
  ;;获取当前工作目录
  (setq path (DL_GetCurPrjDir))
  (princ "\n 请选择要输出的实体:")
  (setq ss1 (ssget))
  (if ss1
    (progn
      ;;获取实体处理文件名称及路径
      (setq pfname (getfiled "输出图形保存在..." path "dwg" 1))
      (if pfname
	(progn
	  (if (findfile pfname)
	    (command "wblock" pfname "y" "" "0,0" ss1 "")
	    (command "wblock" pfname "" "0,0" ss1 "")
	  )
	  (command "_.oops")
	  ;;告诉用户实体处理文件存放地址及名称
	  (DL_MsgOK
	    (strcat "所选实体已经成功输出到文件 <" pfname "> 中!")
	  )
	)
      )
    )
  )
  (pub_save_var)
  (princ)
)
;;;====================================================================
;;;辅助子函数 -- 裁出指定区域内除指定图层外的所有实体
;;;代码编写   -- 汪洪涛
;;;完成时间   -- 2001-01-15
;;;函数名     -- pmcutdwg_cut
;;;参数       -- 顺序角点表 xc_cnpb = (list  xc_p1 xc_p2 xc_p3 xc_p4)
;;;           -- 层表 xc_layb = (list "AXIS" "ROAD" "ROAD-1" "XROAD")
;;;返回值     -- 裁出的实体选择集
;;;
;;;2002.08.13 tue by wei
;;;方法: 根据点表，向内偏移，又生成一个点表。两点表之间的实体被trim掉，
;;;      用"CP"方式，构造点表内部实体的选择集
;;;
;;;
;;;====================================================================
(defun pmcutdwg_cut (xc_cnpb	 xc_layb     /		 w_ii
		     w_blen	 w_lay	     w_cnpb	         w_outpb
		     w_next	 w_ssdel     w_out_prep	     w_out_sucp
		     w_in_prep	 w_in_sucp   w_prep_mp	 w_sucp_mp
		     w_ret_ss    w_pt_temp   ii          et
		     EntData     PtList  w_cutptb		w_count
		    )
  (#ppas "drawroad")
  (setq	w_ii   1
	      w_blen (length xc_cnpb)
  )
  (if (> w_blen 2)
    (progn
      (setq w_cnpb (append xc_cnpb (list (car xc_cnpb))))
      ;;;取得放大一圈以后的点表
      
      (setq w_outpb (hy_outoff_ptb xc_cnpb -0.01));;;任蔚青重新编写的函数，在drawroad.arx中
      (if w_outpb
	 (setq w_outpb (append w_outpb (list (car w_outpb))))
      )
      (if (= (length w_cnpb) (length w_outpb))
      	(setq w_next 1)
      	(setq w_next 0)
      )
    )
  )
  
  ;(getpoint)
  (if (= w_next 1)
    (progn
      (HY_SV)
      
      ;;;(command "zz")
      ;;(zoomex)
      ;;(getpoint)
      ;;(command "zoom" "e" "");;;;modify by wzy
      (setq w_blen (length w_outpb)
      	    w_ii   1
      )
      
      (if xc_layb
      	(foreach w_lay xc_layb
      	(if (tblsearch "LAYER" w_lay)
      	  (if (= (getvar "clayer") (strcase w_lay))
      	    (command "_.layer" "off" w_lay "Y" "")
      	    (command "_.layer" "off" w_lay "")
      	  )
      	)
      )
      )
      (setq w_cutptb nil)
      (setq w_count 0)
      (while (< w_count 9000)
      	(setq w_count (1+ w_count))
      )
      
     
      (while (< w_ii w_blen)
        (setq w_ssdel nil)
      	(setq w_ssdel (ssadd))
      	(setq w_out_prep (nth (- w_ii 1) w_outpb)
      	      w_out_sucp (nth w_ii w_outpb)
      	)
      	(setq w_in_prep	(nth (- w_ii 1) w_cnpb)
      	      w_in_sucp	(nth w_ii w_cnpb)
      	)
      	(setq w_prep_mp	(midpt w_out_prep w_in_prep)
      	      w_sucp_mp	(midpt w_out_sucp w_in_sucp)
      	)
        ;;2002.08.14 wed by wei
        ;;用于构造选择集
      	(setq w_cutptb (cons w_prep_mp w_cutptb))
      	;;
      	(command ^^^ "_.line" w_out_prep w_out_sucp "")
      	(ssadd (entlast) w_ssdel)
      	(command ^^^  "_.line" w_in_prep w_in_sucp "")
      	(ssadd (entlast) w_ssdel)
      	
      	;;
      	;;+++2002.08.13 tue by wei
      	;;这两句是对的,就是遇到"TEXT"等实体时,下面有些提示,不好看
        ;;(command "_.trim" w_ssdel "" "f" w_prep_mp w_sucp_mp "" "")
        ;;(command "_.trim" w_ssdel "" "f" w_prep_mp w_sucp_mp "" "")
        ;;
        ;;对于的SPLINE,POLYLINE，若和边界有n个交点，要trim n次才能完全切断
        ;;实体名字改了，要反复做几次才保险。如果已经切断，也不费时间
        (repeat 4
          (setq ss_gdx (ssget "f" (list w_prep_mp w_sucp_mp) '((-4 . "<not") (0 . "INSERT,TEXT,MTEXT,SOLID,HATCH") (-4 . "not>")) ) )
          (if  ss_gdx
            (progn
              ;;这句不对!
              ;;(command "_.trim" w_ssdel "" ss_gdx "")
              ;;改为：
        	    (command  ^^^ "_.trim" w_ssdel "")
        	    (setq ii 0)
        	    (repeat (sslength ss_gdx)
        	      (setq EntData (car (ssnamex ss_gdx ii))
        	            et      (cadr EntData)
        	            PtList  (cdddr  EntData)
        	      )
        	      ;;(print (cdr (assoc 0 (entget et))))
        	      ;;trim n次!
        	      (foreach w_pt_temp PtList
        	        (setq w_pt_temp (cadr w_pt_temp))
        	        (command (list et w_pt_temp))
        	      )
        	      (setq ii (1+ ii))
        	    )
        	    (command "")
        	  )
          )
        )
        ;;---
        ;;
      	(command  ^^^ "_.erase" w_ssdel "")
      	(setq w_ii (1+ w_ii))
      )
      ;;2002.08.14 wed by wei
      ;;用w_cnpb构造选择集，不可靠，经常漏线
	  (&view_ptb w_cnpb)
      ;;(setq w_ret_ss (ssget "cp" w_cnpb))
      (setq w_ret_ss (ssget "cp" w_cutptb))
      ;;(hy_EntMakePLine w_cutptb "1")
      ;;(getpoint "\n...SSGET!...")
      (foreach w_lay xc_layb
      	(if (tblsearch "LAYER" w_lay)
      	  (command "_.layer" "on" w_lay "")
      	)
      )
      (HY_RV)
    )
  )
  w_ret_ss
)
;;;=================================================================
;;;
;;; 局部取样新程序
;;;
;;;=================================================================
(defun pm_part_cut ( bIsWarning / w_ptb w_pt1 w_pt2 w_pt w_blkn w_cur_path w_ss ltscaleOLD)

  (setq w_cmdecho (getvar "cmdecho"))
  (setvar "cmdecho" 0) 
  (if bIsWarning
    (DL_MsgOK "局部取样可能会破坏图形中部分有用信息，\n在进行该操作前请备份您的图形!"  )
  )
  (szload pub_save_var "wwpublic")
  (#ppls "pppp")
  (pub_save_var)
  ;;2002.08.13 tue by wei 虚线有时不能选中
  (setq ltscale (getvar "ltscale"))
  (command ".ltscale" 0.0001)
  ;;
  (setq w_ptb nil)
  (initget "R")
  (setq w_pt1 (getpoint "\n回车退出 / 任意多边形R / 矩形区域第一点:"))
  (cond
    ;;回车退出
    ((null w_pt1) (setq w_ptb nil))
    ;;矩形区域
    ((listp w_pt1)
      (setq w_pt2 (getcorner w_pt1 "\n矩形区域第二点:"))
      (if w_pt2
        (setq w_ptb (cons w_pt1 w_ptb)
      	      w_pt  (list (car w_pt1) (cadr w_pt2) 0.0)
      	      w_ptb (cons w_pt w_ptb)
      	      w_ptb (cons w_pt2 w_ptb)
      	      w_pt  (list (car w_pt2) (cadr w_pt1) 0.0)
      	      w_ptb (cons w_pt w_ptb)
        )
      )
    )
    ;;任意多边形
    (t
      (setq w_pt1 (getpoint "\n回车退出 / 任意多边形区域第一点:"))
      (if w_pt1
        (setq w_ptb ($get_ptb w_pt1))
      )
    )
  )
  ;;
  (if w_ptb
    (progn
      ;;一个被下面的HY_UndoB()取消了
      (HY_UndoM)
      (HY_UndoM)
      (setq w_ss (pmcutdwg_cut w_ptb nil))
      (if w_ss
	      (progn
	        ;;(command ".move" w_ss "" pause pause)
          ;;;提取当前工程目录
	        (setq w_cur_path (DL_GetCurPrjDir))
	  (if (null w_cur_path) 
	     (progn
	      (setq w_cur_path (HY_getworkdir))
	      (if w_cur_path (setq w_cur_path (substr w_cur_path 1 (- (strlen w_cur_path) 2))))
	     )
	  )
          ;;;创建临时目录
      	  (HY_MkMDir (strcat w_cur_path "\\hysztemp"))
      	  (setq w_blkn (strcat w_cur_path "\\hysztemp\\hyszjbqy.dwg"))
      	  (if (findfile w_blkn)
      	    (command "_.wblock" w_blkn "Y" "" (car w_ptb) w_ss "")
      	    (command "_.wblock" w_blkn "" (car w_ptb) w_ss "")
      	  )
      	)
      )
      (HY_UndoB)
      (if w_ss
      	(progn
      	  (prompt "\n输入局部图放置点:")
          (command "insert" (strcat "hyszjbqy=" w_blkn) pause 1.0 1.0 0.0)
      	  (command "_.explode" (entlast))
      	)
      )
    )
  )
  (pub_re_var)
  (command ".ltscale" ltscaleOLD)
  (setvar "cmdecho" w_cmdecho) 
  (princ)
)


(defun sz_smp_tk (xc_th / a b c yy a3 a4 a2 a1 sca w_bind_wid )
  (szload pub_save_var "wwpublic")
  (pub_save_var)
  (setq w_old_layer (getvar "clayer"))
  (DL_MakeLayer "pp-pm-tk")
  (setq sca (/ 1.0 (DL_GetDrawingFactor)))
  (if (/= sca nil)
    (progn
      (setq a (getpoint "\n输入图框的左下角<0,0>:"))
      (if (null a)
	(setq a '(0 0 0))
      )
      (setq y 10)
      (cond
	((= xc_th 0)
	 (setq b 1189
	       c 841
	 )
	)
	((= xc_th 1)
	 (setq b 841
	       c 594
	 )
	)
	((= xc_th 2)
	 (setq b 594
	       c 420
	 )
	)
	((= xc_th 3)
	 (setq b 420
	       c 297
	 )
	)
	((= xc_th 4)
	 (setq b 297
	       c 210
	 )
	)
      )
      (if (= xc_th 3)
	(setq w_bind_wid 30)
	(if (= xc_th 4)
	  (setq w_bind_wid 25)
	  (setq w_bind_wid 35)
	)
      )
      (command "pline"
	       (setq a1	(list (+ (car a) (* sca w_bind_wid))
			      (+ (cadr a) (* y sca))
			)
	       )
	       "w"
	       (* sca 0.7)
	       (* sca 0.7)
	       (setq a2 (polar a1 0.0 (* (- b w_bind_wid y) sca)))
	       (setq a3 (polar a2 (/ pi 2) (* (- c y y) sca)))
	       (setq a4 (polar a3 pi (* (- b w_bind_wid y) sca)))
	       "close"
      )
      (command "pline"
	       a
	       "w"
	       0.0
	       0.0
	       (setq a1 (polar a 0 (* sca b)))
	       (setq a2 (polar a1 (/ pi 2.0) (* sca c)))
	       (setq a3 (polar a2 pi (* sca b)))
	       "C"
      )
    )
  )
  (command ".zoom" "w" a a2)
  (setvar "clayer" w_old_layer)
  (pub_re_var)
  (princ)
)
;;;DrawTuKuang


;;;返回值：(tk_length tk_width tk tq  whichbutton)
;;;tk_length : 图框长度
;;;tk_width  : 图框宽度
;;;tk        : 0(横式),1(立式)
;;;whichbutton:点击了哪个按钮,1(裁图)，0(确认)
(defun For_DrawTuKuang (  /	       	   
	       m_rang	   m_pi05      m_basp	   m_swid
	       m_lwid	   m_inp1      m_inp2	   m_inp3
	       m_inp4	   m_ent       m_ss	   m_cur_path
	       m_blkn      tk_vtk      w_dtpb      slayer
	       L_rang ;; 旋转角
	       L_DrawTkList ;;DrawTk返回的参数
	       L_retList1 ;;
	       L_TkLen   ;; 图框长度
				 L_TkWid   ;; 图框宽度
				 L_TkMode  ;; 0(横式),1(立式)
				 L_TkTq    ;; 图签样式 (0--3)
				 L_WhichButton ;; 点击了哪个按钮,1(裁图)，0(确认)
				 L_dInnerLeng  ;; 内框长
				 L_dInnerWidth ;; 内框宽
				 L_insPt
				 L_ent1
				 L_ent2
				 L_ss
				 L_LbPt ;; 图框有效区域左下角
	       L_RtPt ;; 图框有效区域左上角
	       pt_list
	       L_sca
	       insertpt ;;图框中心点
	      )
;;;内部辅助函数 -- 用矢量线绘制图框轮廓
(defun tk_vtk (xc_basp xc_dtp)
  (grdraw xc_basp xc_dtp -1)
  (if (= L_TkMode 1)
    (progn
      ;;立式图框
      ;;四个图框内角点(逆时针方向)
      (setq m_inp1 xc_dtp
           m_inp2 (polar m_inp1 m_rang L_dInnerLeng)
           m_inp3 (polar m_inp2 (+ m_rang m_pi05) L_dInnerWidth)
           m_inp4 (polar m_inp3 (+ m_rang pi) L_dInnerLeng)
      )
    )
    (progn
      ;;横式图框
      ;;四个图框内角点(逆时针方向)
     (setq m_inp1 xc_dtp
           m_inp2 (polar m_inp1 m_rang L_dInnerLeng)
           m_inp3 (polar m_inp2 (+ m_rang m_pi05) L_dInnerWidth)
           m_inp4 (polar m_inp3 (+ m_rang pi) L_dInnerLeng)
     )
    )
  )
  (grdraw m_inp1 m_inp2 -1)
  (grdraw m_inp3 m_inp2 -1)
  (grdraw m_inp3 m_inp4 -1)
  (grdraw m_inp1 m_inp4 -1)
)
(#ppas  "HY_TuKuang")
  (szload pub_save_var "wwpublic") 
  (szload szgx_caltk_blur "pmctinps")
  (pub_save_var)
  (setq slayer (getvar "clayer"))
   ;;;

	(setq L_retList1 (drawtukuang t))
	(if L_retList1
		(progn
			(setq L_TkLen  (nth 0 L_retList1)) ;; 图框长度
		  (setq L_TkWid  (nth 1 L_retList1)) ;; 图框宽度
		  (setq L_TkMode (nth 2 L_retList1)) ;; 0(横式),1(立式)
		  (setq L_TkTq   (nth 3 L_retList1))
		  (setq L_WhichButton (nth 4 L_retList1));; 点击了哪个按钮,1(裁图)，0(确认)
		)
	)
	(if (= L_WhichButton 1)
		(progn
			  (#ppas  "DrawRoad")
			  (setq L_rang (DrawRoad_CkxDw));;旋转角
			  (#ppuas  "DrawRoad")
		    ;;求四个内角点
		    (if L_rang       ;;如果参考线选择成功
		     	(progn
			    (setq m_rang (dtor L_rang)
			    m_pi05 (* 0.5 pi)
			    m_basp (qdqpmd) ;;;求当前屏幕左下角和右上角点
			    m_basp (midpt (car m_basp) (cadr m_basp))
			    L_sca (DL_GetDrawingFactor)
			    m_swid (/ L_TkWid L_sca) ;; 内边宽度
			    m_lwid (/ L_TkLen L_sca);; 内边长度
			    )
			    (setq L_ent1 (entlast))
			    (setq L_DrawTkList (DrawTk (list 0 0 0) L_TkLen L_TkWid L_TkMode L_TkTq) )
			    (setq L_ent2  (entlast))
			    (if L_ent1 
				(setq L_ent1 (entnext L_ent1)) 
				(setq L_ent1 L_ent2)
			    )
			    (setq L_ss (ssadd))
			    (while L_ent1
				(setq L_ss (ssadd L_ent1 L_ss))
				(setq L_ent1 (entnext L_ent1))
			    )			
			    (command "erase" L_ss "")
			    (setq L_ss nil )		

			    (setq pt_list (szgx_caltk_blur L_DrawTkList L_TkTq) )
			    (setq L_LbPt (car pt_list)  ;;内框左下角
						L_RtPt (cadr pt_list) ;;内框右上角
			    )
			    (setq L_dInnerLeng  (- (nth 0 L_RtPt) (nth 0 L_LbPt)) ;; 内框长 已经考虑过放置样式
		  	          L_dInnerWidth (- (nth 1 L_RtPt) (nth 1 L_LbPt)) ;; 内框宽 已经考虑过放置样式
		  	    )
		            ;;;
		            ;;裁图矩形的长和宽
		            (setq L_dInnerLeng (* L_dInnerLeng 0.85))
		            (setq L_dInnerWidth (* L_dInnerWidth 0.85))
		            		
			    (setq w_dtpb ($dtfx m_basp tk_vtk "\n 回车取消 / 点取图框基点:"))
			    (if w_dtpb
			      (progn
			        (setq m_basp (cadr w_dtpb))
			        ;;;裁图矩形的4个内角点
			        (setq m_inp1 m_basp
			              m_inp2 (polar m_inp1 m_rang L_dInnerLeng)  ;;L_dInnerLeng
			              m_inp3 (polar m_inp2 (+ m_rang m_pi05) L_dInnerWidth)
			              m_inp4 (polar m_inp3 (+ m_rang pi) L_dInnerLeng)
			        )
			        
			        ;;裁图
			        ;;(command "_.erase" m_ent "")
			        (HY_UndoM)
			        (setq
			          m_ss (pmcutdwg_cut (list m_inp1 m_inp2 m_inp3 m_inp4) nil)
			        )
			        (if m_ss
			          (progn
									;;;提取当前工程目录
			            (setq m_cur_path (DL_GetCurPrjDir))
			             (if (null m_cur_path) 
							      (progn
							        (setq m_cur_path (HY_getworkdir))
							        (if m_cur_path (setq m_cur_path (substr m_cur_path 1 (- (strlen m_cur_path) 2))))
							      )
							     )
									;;;创建临时目录
			            (HY_MkMDir (strcat m_cur_path "\\hysztemp"))
			            (setq
			              m_blkn (strcat m_cur_path "\\hysztemp\\hyszjbqy.dwg")
			            )
			            (setq L_dInnerLeng (/ L_dInnerLeng 2.0))
			            (setq L_dInnerWidth (/ L_dInnerWidth 2.0))
			            (setq insertpt m_basp
			                  insertpt (polar insertpt m_rang L_dInnerLeng)
			                  insertpt (polar insertpt (+ m_rang m_pi05) L_dInnerWidth)
			            )
			            (if (findfile m_blkn)
			              (command "_.wblock" m_blkn "Y" "" insertpt m_ss "")
			              (command "_.wblock" m_blkn "" insertpt m_ss "")
			            )
			          )
			        )
			        (HY_UndoB)
			        (if m_ss
			          (progn
			            (DL_MakeLayer "pp-pm-tk")
			            ;;(prompt "\n 点取局部图放置点:")
			            (setq L_insPt (getpoint "\n 点取局部图放置点: "))
			            (sa_osmode)
			            (setvar "osmode" 0)
			            (setq L_DrawTkList (DrawTk L_insPt L_TkLen L_TkWid L_TkMode L_TkTq))
			            (setq pt_list (szgx_caltk_blur L_DrawTkList L_TkTq) )
									(setq L_LbPt (car pt_list)  ;;内框左下角
												L_RtPt (cadr pt_list) ;;内框右上角
									)
				    (setq L_LbPt (polar L_LbPt (angle L_LbPt L_RtPt) (/ (distance L_LbPt L_RtPt) 2.0)))
			            (command "insert" (strcat "hyszjbqy=" m_blkn) L_LbPt    1.0     1.0     (- L_rang)      )
			            (command "_.explode" (entlast))
			
			            (re_osmode)
			          )
			        )
			      )
			    )
			)
		)
  	)
  )
  (setvar "clayer" slayer)
  (pub_re_var)
  (#ppuas  "HY_TuKuang")
  (princ)
)
(defun $dtfx (p	fun prom / temp_p whilevar flag_d dmt_pl k_code	dmt_p
	      plast)
  (if (null prom)
    (setq prom "\n点示方向:")
  )
  (setq temp_p p)
  (prompt prom)
  (setq	whilevar t
	flag_d t
  )
  (while whilevar
    (setq dmt_pl (grread 15 1))
    (setq k_code (car dmt_pl)
	  dmt_p	 (cadr dmt_pl)
    )
    (cond
      ((and (= k_code 5) (not (equal dmt_p temp_p 0.001)))
       (if (null flag_d)
	 (fun p temp_p)
       )
       (fun p dmt_p)
       (setq flag_d nil)
       (setq temp_p dmt_p)
      )
      ((= k_code 3)
       (if (null flag_d)
	 (fun p temp_p)
       )
       (setq plast dmt_p
	     whilevar nil
       )
      )
      ((and (or (= k_code 12) (= k_code 2))
	    (not (equal temp_p p 0.001))
       )
       (if (null flag_d)
	 (fun p temp_p)
       )
       (setq plast nil
	     whilevar nil
       )
      )
    )
;;;end cond
  )
;;;end while
  (if plast
    (list (angle p plast) plast k_code)
    nil
  )
)
(princ)