;;;
;;;1998.04.25
(defun #tkth (/	    y	  y1	k     bl    oldbl ss	len   blkn
	      lay   entb  tkb	ent   uctr  e	  eb	tkm   xsca
	      ysca  zsca  etype
	     )
  (szload pub_save_var "wwpublic")
  (pub_save_var)
  (setq	oldbl 1.0
	uctr  (HY_ClearUNDO)
  )
  (setq y t)
  (while y
    (setq ent (HY_SelSingleEnt "\n回车退出 / 回退 U / 选目标图块:"
		       "INSERT"
		       nil
		       nil
		       "U"
	      )
    )
    (cond
      ((null ent) (setq y nil))
      ((= ent "RETURN") (prompt "\n未选中块,重选."))
      ((= ent "U")
       (if (<= (getvar "undomarks") uctr)
	 (prompt "\n已全部回退!")
	 (HY_UndoB)
       )
      )
      (t
       (setq y1 t)
       (while y1
	 (setq e (HY_SelSingleEnt "\n选取要替换块中的一个:" "INSERT" nil nil))
	 (cond
	   ((null e) (setq y1 nil))
	   ((= e "RETURN") (prompt "\n未选中块,重选."))
	   (t
	    (setq e	(car e)
		  eb	(entget e (list "*"))
		  etype	(cdr (assoc 0 eb))
		  lay	(strcase(cdr (assoc 8 eb)))
	    )
	    (redraw e 3)
	    (setq tkm (strcase(cdr (assoc 2 eb))))
	    (prompt (strcat "\n过滤"	     lay
			    "层的"	     etype
			    "实体"	     tkm
			    ",请选择范围(全选敲all):"
			   )
	    )
	    (setq ss
		   (ssget (list (cons 0 etype) (cons 2 tkm) (cons 8 lay)))
	    )
	    (if	(null ss)
	      (progn (setq ss (ssadd)) (ssadd e ss))
	    )
	    (if	ss
	      (progn
		(initget 6)
		(setq bl
		       (getdist
			 (strcat "\n图块缩放系数<" (rtos oldbl 2 2) ">:")
		       )
		)
		(if bl
		  (setq oldbl bl)
		  (setq bl oldbl)
		)
		(setq entb (entget (car ent) (list "*"))
		      blkn (strcase(cdr (assoc 2 entb)))
		      lay  (strcase(cdr (assoc 8 entb)))
		      xsca (* bl (cdr (assoc 41 entb)))
		      ysca (* bl (cdr (assoc 42 entb)))
		      zsca (* bl (cdr (assoc 43 entb)))
		      len  (sslength ss)
		      k	   0
		)
		(HY_UndoM)
		(repeat	len
		  (setq ent (ssname ss k))
		  (setq	eb   (entget ent)
			entb (subst (cons -1 ent) (assoc -1 entb) entb)
			entb (subst (cons 10 (cdr (assoc 10 eb)))
				    (assoc 10 entb)
				    entb
			     )
			entb (subst (cons 5 (cdr (assoc 5 eb)))
				    (assoc 5 entb)
				    entb
			     )
			k    (1+ k)
		  )
		  (if (not (equal bl 1.0 0.001))
		    (setq entb (subst (cons 41 xsca) (assoc 41 entb) entb)
			  entb (subst (cons 42 ysca) (assoc 42 entb) entb)
			  entb (subst (cons 43 zsca) (assoc 43 entb) entb)
		    )
		  )
		  (entmod entb)
		  (entupd ent)
		)
	      )
	    )
;;;end of if ss
	    (redraw e 4)
	    (setq y1 nil)
	   )
;;;;end of t
	 )
       )
      )
    )
  )
  (pub_re_var)
  (princ)
)

;;;modi 1998.02.02
;;;modi 1998.02.24
;;;modi 1998.04.01 1998.06.11
;;;15:36 98-11-11
(defun #tree1 (w_tk /     dm	   y	 y1    pt     dwg   k	 h     bzfw
	       glb   dis   ss	 oldvar	     ans   ane	 p1  p2  wid  entb
	       ss1   rwid  wid1  d   lay   ptb pl_ptb  w_tk  tkm
	       vp    lth   i      flag   sym_b  etype  ang ent2 wb_stcs pt_inst )
  (HY_Set0)
  (pusherr #tree1_err)
  (setq	;;;olderr	*error*
	;;;*error*	#tree1_err
	lay	"PP-PMTREE"
  )
  (setq tkm (substr w_tk (- (strlen w_tk) 9) 6))

  (if (null tree:d)
   (setq tree:d 20.0)
  )
  (if (null tree:j)
    (setq tree:j 5.0)
  )
  (setq wid1 (getvar "offsetdist"))
  (if (<= wid1 0)
    (progn
      (setvar "offsetdist" 3.0)
      (setq wid1 3.0)
    )
    (setvar "offsetdist" wid1)
  )
  (setq	glb (list (cons -4 "<or")
		              (cons 0 "*LINE")
		              (cons 0 "ARC")
		              (cons 0 "LWPOLYLINE")
		              (cons -4 "or>")

		        )
	)
  (HY_UndoM)
 ;;;  (setq *error* nil)
   (setq vp (getvar "viewctr"))
   (setq flag nil)
   (setq sym_b (tblnext "block" t))
   (while (and sym_b (= flag nil))
          (if (= (strcase(cdr (assoc 2 sym_b))) tkm)
              (setq flag t)
          )
          (setq sym_b (tblnext "block"))
   )


   (if (= flag nil)
      (progn
        (command "insert" w_tk vp "" "" 0 )
        (entdel (entlast))
       )
  )
  (setq y t)
  (while y
    (setq entb ($p_to_e "\n 回车退出 / 请选择道路边线:" nil glb 512))
    (if (= entb nil)
      (setq y nil)
      (progn
	    (setq ent (car entb)
	          p1  (cadr entb)
	    )
	    (if ent
		(progn
		      (initget 1)
		      (setq p2 (getpoint (trans p1 0 1)  "\n 请点示布置偏移方向:"))
		      (initget 6)
		      (setq wid1  (getdist (strcat "\n偏移距离：<" (rtos (getvar "offsetdist") 2 2) ">:")))
		      (if wid1 (setvar "offsetdist" wid1))
		     ;;;; (setq p2 (polar p1 ang 1))
		      (initget 6)
		      (setq h
		           (getdist (strcat "\n直径<" (rtos tree:j 2 2) ">:"))
		      )
		      (if h
			  (setq tree:j h)
			  (setq h tree:j)
		      )
		      (setq dis
			       (getdist	(strcat "\n间距<" (rtos tree:d 2 2) ">:"))
		      )
		      (if dis
			  (setq tree:d dis)
			  (setq dis tree:d)
		      )
	        (setq h tree:j dis tree:d)  ;;add by 谷德性 2003.1.13
		      ;;;(prompt "\n正在工作,请稍侯...")
	 	      (setq ent (mk_ss_con ent 0.001))
		      (command ".offset"
			 ""
			 (list ent p1)
			 p2
			 ""
		      )
		      (entdel ent)
		      (setq ent (entlast))
	;;	      (command "measure" ent  "b" tkm "" 20)
		      (command "measure" ent  "b" tkm "" dis)  ;;modify by 谷德性 2003.1.13
		      (setq ent2 ent)
		      (while (setq ent2 (entnext ent2))
		       (setq wb_stcs (entget ent2) pt_inst (cdr (assoc 10 wb_stcs)) )
		       (command "scale" ent2 "" pt_inst (/ h 5.0) )
		      )
		      (entdel ent)
		);progn
		(setq y nil)
	    );;;if
	)
      )
  );;;end of while y
 ;;; );;;progn
 ;;; );;;if w_tk
 ;;; (setq *error* olderr)
  (clr_err)
  (redraw)
  (HY_Set1)
  (princ)
)



;;; Define error handler
(defun #tree1_err (msg / glb ss)
;;  (HY_Set0)
;;  (if (equal msg "Function cancelled")
;;					;prompt "\n用户按 <Ctrl+C> 中断!")
;;    (princ)
;;  )
;;  (setq *error* olderr)
  (setq	glb (list (cons -4 "<or")
		  (cons 0 "*LINE")
		  (cons 0 "ARC")
		  (cons -4 "or>")
		  (cons -4 "<or")
		  (cons 8 lay)
		  (cons 8 lay2)
		  (cons -4 "or>")
	    )
	ss  (ssget "x" glb)
  )
  (if ss
    (command ".erase" ss "")
  )
  (redraw)
;;  (HY_RV)
;;  (HY_Set1)
  (princ)
)
;;;沿任意参考线布置平面树
;;;直线的布置起点由用户点取的方向点决定，弧的布置起点由选择点决定
(defun laytree_line (/        w_layer  w_sca    w_prm1   w_glb
                     w_tk     w_h      w_dis    w_tksca  w_aline
                     w_ent    w_edata  w_etype  w_locp   w_dp
                     w_sp     w_ep     w_ang    w_pp     w_vang
                     w_hang   w_bp     w_nextp  w_earrow w_fdist
                     w_offd   w_adist  w_ecopy  w_pt     w_arcb
                     w_cenp   w_r      w_sang   w_eang   w_mp
                     w_aang   w_jp     w_dist   w_lr     w_fang
                     w_stepa  w_bang   w_addang key      
                     p1  ent ent2  tkm  wb_stcs pt_inst
                    )
  (szload pub_save_var "wwpublic")
  (pub_save_var)
  (szload $p_to_e "pppp")
  (DL_ArxLoad "GalleryManage")
  (setq w_layer "PP-PMTREE"
        w_sca   (DL_GetDrawingFactor)
        w_prm1  "\n 回车退出 / 靠近布置起点选择线或弧:"
        w_glb   '((0 . "LINE,ARC,LWPOLYLINE"))
  )
  (if (null tree:d)
    (setq tree:d 20.0)
  )
  (if (null tree:j)
    (setq tree:j 5.0)
  )
  (HY_SV)
  (DL_MakeLayer w_layer)
  (while (setq w_tk (DL_ShowGallery "平面树"))
  (initget "Z")
  (setq key (getkword "\n 整条路布置 Z /<分段布置:>"))
  (if key (#tree1 w_tk)
  (progn
    (initget 6)
    (setq w_h (getdist (strcat "\n 树冠直径<" (rtos tree:j 2 2) ">:")))
    (if w_h
      (setq tree:j w_h)
      (setq w_h tree:j)
    )
    (setq
      w_dis (getdist (strcat "\n 树间距<" (rtos tree:d 2 2) ">:"))
    )
    (if w_dis
      (setq tree:d w_dis)
      (setq w_dis tree:d)
    )
    (setq w_h tree:j w_dis tree:d)  ;;add by 谷德性 2003.1.13
    (setq w_tksca (/ w_h 5.0 w_sca))
    (while (setq w_aline ($p_to_e w_prm1 nil w_glb 512))
      (setq w_ent   (car w_aline)
            p1      (cadr w_aline)
            w_edata (entget w_ent)
            w_etype (cdr (assoc 0 w_edata))
            w_locp  ($set_p_on_e w_aline)
      )
      (initget 1)
      (setq w_dp (getpoint w_locp "\n 点示布置方向:"))
      (cond
        ((= w_etype "LINE") 
          (setq w_sp   (cdr (assoc 10 w_edata))
                w_ep   (cdr (assoc 11 w_edata))
                w_ang  (angle w_sp w_ep)
                w_pp   ($qtyd1 w_dp w_sp w_ep)
                w_vang (angle w_pp w_dp)
                w_hang (angle w_locp w_pp)
          )
          (if (equal w_ang w_hang 0.001)
            (setq w_bp w_sp
                  w_nextp w_ep
            )
            (setq w_bp w_ep
                  w_nextp w_sp
            )
          )
          (pub_arrow_wmk w_bp w_hang)
          (setq w_earrow (entlast))
          (initget 4)
          (setq w_fdist (getreal "\n第一棵树与端点的距离<0.0>:"))
          (if (null w_fdist)
            (setq w_fdist 0.0)
          )
          (initget 4)
          (setq w_offd (getreal "\n树与参照线的偏移距离<0.0>:"))
          (if (null w_offd)
            (setq w_offd 0.0)
          )
          (command "_.erase" w_earrow "")
          (setq w_bp (polar w_bp w_hang w_fdist)
                w_bp (polar w_bp w_vang w_offd)
          )
          (setq w_adist (distance w_bp w_nextp))
          (command "_.insert" w_tk w_bp w_tksca w_tksca 0)
          (setq w_ecopy (entlast))
          (setq w_pt (polar w_bp w_hang w_dis))
          (while (< (distance w_bp w_pt) w_adist)
            (command "_.copy" w_ecopy "" w_bp w_pt)
            (setq w_pt (polar w_pt w_hang w_dis))
          )

        )
        ;;end of LINE
        ((= w_etype "ARC")
          (setq w_arcb ($arc_csb w_ent)
                w_cenp (nth 0 w_arcb)
                w_r    (nth 1 w_arcb)
                w_sang (nth 2 w_arcb)
                w_eang (nth 3 w_arcb)
                w_sp   (nth 4 w_arcb)
                w_ep   (nth 5 w_arcb)
                w_mp   (nth 6 w_arcb)
                w_aang (nth 7 w_arcb)
                w_jp   (nth 9 w_arcb)
                w_dist (distance w_cenp w_dp)
                w_lr   (pub_lr_pt w_locp w_cenp w_mp)
          )
          ;;判断所选点与哪个端点近
          (if (or (= w_lr "L") (= w_lr "l"))
            (setq w_bp w_ep)
            (setq w_bp w_sp)
          )
          (setq w_hang (angle w_bp w_jp))
          (if (> w_aang pi)
            (setq w_hang (rem (+ w_hang pi) (* 2.0 pi)))
          )
          (pub_arrow_wmk w_bp w_hang)
          (setq w_earrow (entlast))
          (initget 4)
          (setq w_fdist (getreal "\n第一棵树与端点的距离<0.0>:"))
          (if (null w_fdist)
            (setq w_fdist 0.0)
          )
          (initget 4)
          (setq w_offd (getreal "\n树与参照线的偏移距离<0.0>:"))
          (if (null w_offd)
            (setq w_offd 0.0)
          )
          (command "_.erase" w_earrow "")
          ;;判断在那侧布置
          (if (< w_dist w_r)
            (setq w_r (- w_r w_offd))
            (setq w_r (+ w_r w_offd))
          )
          (if (> w_r 1.0)
            (progn
              ;;求旋转角
              (setq w_fang  (/ w_fdist w_r)
                    w_stepa (/ w_dis w_r)
                    w_aang  (- w_aang w_fang)
              )
              (if (or (= w_lr "L") (= w_lr "l"))
                (progn
                  (setq w_bang (- w_eang w_fang)
                        w_bp   (polar w_cenp w_bang w_r)
                  )
                  (command "_.insert" w_tk w_bp w_tksca w_tksca 0)
                  (setq w_ecopy (entlast))
                  (setq w_addang 0.0)
                  (while (< w_addang w_aang)
                    (setq w_addang (+ w_addang w_stepa)
                          w_bang   (- w_bang w_stepa)
                          w_pt     (polar w_cenp w_bang w_r)
                    )
                    (command "_.copy" w_ecopy "" w_bp w_pt)
                  )
                )
                (progn
                  (setq w_bang (+ w_sang w_fang)
                        w_bp   (polar w_cenp w_bang w_r)
                  )
                  (command "_.insert" w_tk w_bp w_tksca w_tksca 0)
                  (setq w_ecopy (entlast))
                  (setq w_addang 0.0)
                  (while (< w_addang w_aang)
                    (setq w_addang (+ w_addang w_stepa)
                          w_bang   (+ w_bang w_stepa)
                          w_pt     (polar w_cenp w_bang w_r)
                    )
                    (command "_.copy" w_ecopy "" w_bp w_pt)
                  )
                )
              )
            )
          )
        )
        ;;end of ARC
        ((= w_etype "LWPOLYLINE")
	      (command ".offset"
		       ""
		      (list w_ent p1)
		      w_dp
		      ""
	      )
	      (setq ent (entlast))
	      (command "_.insert" w_tk p1 w_tksca w_tksca 0)
	      (setq w_ecopy (entlast))
	      (setq tkm (substr w_tk (- (strlen w_tk) 9) 6))
	      (command "measure" ent  "b" tkm "" w_dis)
	      (entdel w_ecopy)
	      (setq ent2 ent)
	      (while (setq ent2 (entnext ent2))
	       (setq wb_stcs (entget ent2) pt_inst (cdr (assoc 10 wb_stcs)) )
	       (command "scale" ent2 "" pt_inst (/ w_h 5.0) )
	      )
	      (entdel ent)
      );;end of LWPOLYLINE
    ) ;;end of cond
   );;end of inside while
    );;;progn
  );;;if
  );;end of outside while

  (HY_RV)
  (pub_save_var)
  (princ)
)
;;;wri yft 99.11.12
;;;三维建筑物图库
;;;=========================
(defun ?jj_3djzw (/ blkname loop loop1 pt sca1)
  (HY_Set0)
  (setq loop t)
  (DL_ArxLoad "GalleryManage")
  (while loop
    (setq blkname (DL_ShowGallery "三维建筑"))
    (if	(= 'STR (type blkname))
      (progn
	(setq loop1 t
	      sca1 nil
	)
	(while loop1
	  (setq pt (getpoint "\n回车退出 / <插入点>:"))
	  (if pt
	    (progn
	      (if (null sca1)
		(progn
		  (initget 6)
		  (setq sca1 (getreal "\n 请输入放大系数:<1.0> "))
		  (if (null sca1)
		    (setq sca1 1.0)
		  )
		)
	      )
	      (command ".insert" blkname pt sca1 "")
	      (princ "\n 请选取旋转角度:")
	      (command pause)
	    )
	    (setq loop1 nil)
	  )
	)
      )
      (setq loop nil)
    )
  )
  (HY_Set1)
  (princ)
)
;;;modi 1998.02.02
;;;modi 1998.02.24 1998.06.11
(defun #tree4 (xz    /     dm    y     y1    p     dwg   h     glb
               dis   d     bzfw  oldvar      wid1  ss
               lay1  tkm   sca
              )
  (szload pub_save_var "wwpublic")
  (pub_save_var)
  (DL_ArxLoad "GalleryManage")
  (setq lay1 "PP-PMTREE"
        sca  (DL_GetDrawingFactor)
  )
  (DL_MakeLayer lay1)
  (if (null tree:d)
    (setq tree:d 20.0)
  )
  (if (null tree:j)
    (setq tree:j 5.0)
  )
  (while (setq dm (DL_ShowGallery "平面树"))
    (initget 6)
    (setq h (getdist (strcat "\n直径<" (rtos tree:j 2 2) ">:")))
    (if h
      (setq tree:j h)
      (setq h tree:j)
    )
    (while (setq p (getpoint "\n回车退出 / <插入点>:"))
      (command ".insert" dm p (/ h 5.0 sca) "" 0.0)
    )
  )
  (pub_re_var)
  (princ)
)

;;;自动搜索选择实体所在层上的连续实体(line arc polyline lwpolyline )，
;;返回由选择集内实体所形成的PLINE实体名
(defun mk_ss_con( w_ent acc / res acc w_ent w_eb  w_etyp w_ptb w_sp w_ep w_peb pp_cw1 pp_cw2 ss lth ent ds1 ds2 vp etype entb view_pt)
 ;;; (setq w_ent (car (entsel "please select a entity:")))
 ;;; (#ppls "pppp")
  (if (/= w_ent nil)
    (progn
       (setq res (ssadd))
       (ssadd w_ent res)
       (setq acc (* (DL_GetDrawingFactor) 0.01)
             w_eb	 (entget w_ent)
	          w_etyp (cdr (assoc 0 w_eb))
        )
        (setq w_ptb	(bg-ypp w_ent)
	            w_sp	(last w_ptb)
	            w_ep	(car w_ptb)

       )
       (setq	type1	(list	'(0 . "LINE,ARC,LWPOLYLINE,POLYLINE")
							    					(assoc 8 (entget w_ent))
											     )
					    )
       (setq	pp_cw1 (polar w_sp (* pi 0.25) 1.0)
							pp_cw2 (polar w_sp (* pi 1.25) 1.0)
				)
				(setq view_pt (qdqpmd))
				(setq view_pt (append view_pt (list w_sp)))
				(if (pdqpmd  w_sp)
				    (progn

				       (&view_ptb view_pt)
				     )
				 )

				;;;(setq ss (ssget "x" type1))
			 (setq	ss (ssget "C" pp_cw1 pp_cw2 type1))
			 (if ss
			   (progn
			   (ssdel w_ent ss)
			   (if (> (sslength ss) 0) (search w_ent type1 w_sp acc ss res))
         )
       );if
       (setq	pp_cw1 (polar w_ep (* pi 0.25) 1.0)
			  			pp_cw2 (polar w_ep (* pi 1.25) 1.0)
			 )
			 (setq view_pt (append view_pt (list w_ep)))
			 (if (pdqpmd  w_ep)
				    (progn

				       (&view_ptb view_pt)
				     )
				 )
			 (setq	ss (ssget "C" pp_cw1 pp_cw2 type1))
			 (if ss
			   (progn
			   (ssdel w_ent ss)
			   (if (> (sslength ss) 0) (search w_ent type1 w_ep 0.001 ss res))
         )
       );if
     );progn
   );if
   (setq i    0
         lth (sslength res)
         vp (getvar "viewctr")
   )
   (setq ss (ssadd))
   (while (< i lth)
           (setq ent (ssname res i))
           (command ".copy" ent "" vp vp)
           (ssadd (entlast) ss)
           (setq i (1+ i))
   )

   (setq ent (ssname ss 0))
   (setq etype (cdr (assoc 0 (entget ent))))

   (if (= etype "LWPOLYLINE")
       (command ".pedit" ent "j" ss "" "")
       (command "pedit" ent "" "j" ss "" "")
   )

    (setq ent (entlast))
    ;;;(redraw ent 3)
);defun



(defun search (ent type1 pt acc ss res / i tt lth ptb sp ep ee pp ds ds1 ds2 pp_cw1 pp_cw2 fl)
  ;;;(&vec_cir pt 10 10 6 t)
  ;;;(getpoint "\n mmmm")
  (setq i 0
        lth (sslength ss)
        fl  nil
   )
   (while (and (< i lth) (not fl))

          (setq tt (ssname ss i))
          (if (equal tt ent) (setq fl t))
          (setq i (1+ i))
   )
   (if (not fl)
      (progn
      (setq tt (ssname ss 0))
  	  (setq ptb	(bg-ypp tt)
			        sp	(last ptb)
			        ep	(car ptb)
			        ds1 (distance pt sp)
			        ds2 (distance pt ep)
			        ds  (min ds1 ds2)
			        ee  tt
			)
			(if (< ds1 ds2) (setq pp ep) (setq pp sp))
			(setq lth (sslength ss))
		  (setq i 1)
		  (while (< i lth)
		    (progn
		       (setq  tt  (ssname ss i))
		       (setq  ptb	(bg-ypp tt)
		              sp  (last ptb)
		              ep  (car  ptb)
			            ds1 (distance pt sp)
			            ds2 (distance pt ep)
			      )

		       (If (< ds1 ds)
		           (progn
		              (setq ds ds1)
		              (setq ee tt)
		              (setq pp ep)
		            )
		       )
		       (if (< ds2 ds)
		           (progn
		              (setq ds ds2)
		              (setq ee tt)
		              (setq pp sp)
		           )
		       )
		       (setq i (1+ i))
		     );progn
		  );while
		  (if (< ds acc)
		      (progn
			      (ssadd ee res)
			      (setq	pp_cw1 (polar pp (* pi 0.25) 1.0)
									pp_cw2 (polar pp (* pi 1.25) 1.0)
						)
						(setq view_pt (append view_pt (list pp)))
						(if (pdqpmd  pp)
				     (progn

				       (&view_ptb view_pt)
				     )
				    )

						(setq	ss (ssget "C" pp_cw1 pp_cw2 type1))
					  (if ss
					   (progn
					   (ssdel ee ss)
					   (if (> (sslength ss) 0) (search ent type1 pp acc ss res))
		         (HY_SSRedraw ss 3)
		         )
		        );if
			    );progn
			)
	);;;progn
    );;;if
)
