;;;-----------------------------
;;; 1996.10.10 thu
;;; 改TEXT字型 @gstyle.lsp
;;;-----------------------------
(defun gstyle (/ ss fhb stymb txt1b txt2b dcl_id what stym)

  (setvar "cmdecho" 0)
  (setvar "blipmode" 0)

  (prompt "\n选取文字:")
  (setq ss (ssget (list (cons 0 "TEXT"))))

  (setq fhb (getsty))
  (setq	stymb (reverse (nth 0 fhb))
	txt1b (reverse (nth 1 fhb))
	txt2b (reverse (nth 2 fhb))
  )

  (if ss
    (progn
      (setq dcl_id (szdl_load_dlg "@gstyle.dcl"))
      (if (not (new_dialog "gstyle" dcl_id))
	(exit)
      )

      (start_list "xstyle")
      (mapcar 'add_list stymb)
      (end_list)

      (action_tile
	"xstyle"
	"(setq stym (xstyle stymb txt1b txt2b))"
      )

      (action_tile "accept" "(done_dialog 3)")
      (action_tile "cancel" "(done_dialog 0)")

      (setq what (start_dialog))
      (unload_dialog dcl_id)

      (if (= what 3)
	(gtxt ss stym)
      )					;*** change
    )
  )

  (setvar "clayer" "0")
  (princ)
)
;;------------------------------
;; 1996.10.10 thu
;; 改字型
;;------------------------------
(defun gtxt (ss stym / ii e eb ebn)

  (if ss
    (progn
      (setq ii 0)
      (repeat (sslength ss)
	(setq e	 (ssname ss ii)
	      eb (entget e)
	      eb (subst (cons 7 stym) (assoc 7 eb) eb)
	)
	(entmod eb)
	(entupd e)
	(setq ii (1+ ii))
      )
    )
    (prompt "\n没选文字。")
  )
  (princ)
)
;;; *** *** 文字排版
;;;------------------------------
;;; 1996.10.05 sat
;;; 文字调整 
;;;------------------------------
(defun wztz (/ dcl_id what hc gd kgb zjj hjj ang jiao)

  (setvar "cmdecho" 0)
  (setvar "blipmode" 0)
  (setvar "elevation" 0.0)
  (setvar "thickness" 0.0)

  (setq jiao 0.0)			;*** jiao, ...
  (setq ang (/ (* jiao pi) 180.0))

  (setq	hc  "10"
	gd  "3.0"
	kgb "0.8"
	zjj "0.2"
	hjj "1.0"
	dss "2.0"
  )
  (setq dcl_id (szdl_load_dlg "@wztz.dcl"))

  (setq what 4)
  (while (> what 2)
    (if	(not (new_dialog "wztz" dcl_id))
      (exit)
    )
					;----------------------------------------
					;----- set_tile      --------------------
					;----------------------------------------
    (set_tile "zxm" (strcat "字型名:" (getvar "textstyle")))
    (set_tile "hc" hc)
    (set_tile "gd" gd)
    (set_tile "kgb" kgb)
    (set_tile "zjj" zjj)
    (set_tile "hjj" hjj)
    (set_tile "dss" dss)

					;-------------------
					;---   \"  <--->  "
					;-------------------
    (action_tile "szx" "(szx)")
    (action_tile "hc" "(setq hc   (get_tile $key))")
    (action_tile "gd" "(setq gd   (get_tile $key))")
    (action_tile "kgb" "(setq kgb  (get_tile $key))")
    (action_tile "zjj" "(setq zjj  (get_tile $key))")
    (action_tile "hjj" "(setq hjj  (get_tile $key))")
    (action_tile "dss" "(setq dss  (get_tile $key))")
    (action_tile "zbj" "(done_dialog 4)")
    (action_tile "sbj" "(done_dialog 5)")

    (action_tile "sm" "(sm)")

    (action_tile "accept" "(nbcl)")
    (action_tile "cancel" "(done_dialog 0)")

    (setq what (start_dialog))

    (if	(= what 3)
      (tz00 hc gd kgb zjj hjj dss)
    )
    (if	(= what 4)
      (zbj gd)
    )
    (if	(= what 5)
      (sbj)
    )

  )
  (unload_dialog dcl_id)
  (princ)
)
;;--------------------------
;; 打开使用说明
;;--------------------------
(defun sm ()
  (if (not (new_dialog "sm" dcl_id))
    (exit)
  )

  (action_tile "accept" "(done_dialog)")
  (start_dialog)
)
;;--------------------------
;; 置标记
;;--------------------------
(defun zbj (gd / gd p00)

  (if (/= gd "")
    (setq gd (atof gd))
    (setq gd 3.0)
  )

  (while (setq p00 (getpoint "\n标记放置位置:"))
    (if	(highft)
      (command "text" p00 jiao "@")
      (command "text" p00 gd jiao "@")
    )
    (HY_KZSJXZ (entlast) "BJ" 1000 "@")
    (command "change" (entlast) "" "p" "c" "1" "")
  )
  (princ)
)
;;--------------------------
;; 删标记
;;--------------------------
(defun sbj (/ ss)

  (setq
    ss (ssget "x"
	      (list (cons 0 "TEXT") (cons 1 "`@") (list -3 '("BJ")))
       )
  )
  (if ss
    (command "erase" ss "")
  )
  (princ)
)

;;--------------------------
;; 1996.09.14 sat
;; 容错处理
;;--------------------------
(defun nbcl ()

  (cond
    ((<= (atoi hc) 0)
     (alert "每行长度不能≤0。")
     (mode_tile "hc" 2)
    )
    ((<= (atof gd) 0.0)
     (alert "字高应 >0。")
     (mode_tile "gd" 2)
    )
    ((<= (atof kgb) 0.0)
     (alert "字符宽高比不能≤0.0。")
     (mode_tile "kgb" 2)
    )
    (t
     (done_dialog 3)
    )
  )
  (princ)
)

;;----------------------------------
;; 1996.10.06 sun
;; 调整文字 tz00(hc gd kgb zjj hjj)
;; hc : 行长(汉字数)   string
;; gd : 字高           string
;; kgb: 宽高比         string
;; zjj/hjj : 字/行间距 string
;; dss : 段缩回(+)/伸出(-)字数
;;----------------------------------
(defun tz00 (hc	   gd	 kgb   zjj   hjj   dss	 /     hc    gd
	     kgb   zjj	 hjj   dss   ss	   ii	 e     eb    p00
	     tt	   ttb	 ttbb  ft    nn	   p01	 hh    cc1   ccm
	     p000  p001	 flag  hcdc  kgbold	 styb  hift  txt1
	     txt2  txtb
	    )

  (prompt "\n选择要调整的文字<空选返回>:")
  (setq ss (ssget (list (cons 0 "TEXT"))))
  (if ss
    (progn
      (prompt "\n请稍候...")
      (command "undo" "m")		;*** mark ***
      (setq hc	(atoi hc)
	    gd	(atof gd)
	    kgb	(atof kgb)
	    zjj	(atof zjj)
	    hjj	(atof hjj)
	    dss	(atof dss)
      )
					;----- 保留OLD KGB ---------------------------------------
      (setq styb (tblsearch "style" (getvar "textstyle")))
      (setq kgbold (cdr (assoc 41 styb)))
					;--- kgb 不同时须设style ---------      
      (if (equal kgbold kgb 0.05)
	(princ)
	(progn
	  (command "style" (getvar "textstyle") "" "0.0" kgb "" "" "")
	  (if (/= (getvar "cmdnames") "")
	    (command "")
	  )
	)
      )
      (setq hift (highft))		;*** T/nil ***

      (setq ii 0)
      (repeat (sslength ss)
	(setq e	  (ssname ss ii)
	      eb  (entget e)
	      p00 (cdr (assoc 10 eb))
	      tt  (cdr (assoc 1 eb))
	      ttb (cons (list (car p00) (cadr p00) p00 tt) ttb)
	)
	(setq ii (1+ ii))
      )
      (command "erase" ss "")

      (setq ttb (bb2px ttb (* 0.3 gd)))	;*** 误差排序 ***

      (setq ttbb "")
					;----- 字符总串 ttbb ----------------------
      (foreach tt ttb
	(setq ttbb (strcat ttbb (nth 3 tt)))
      )
					;------------------------------------------
					;----- p000 start point  ------------------
					;----- p001 缩进点       ------------------
					;------------------------------------------
      (setq p00 (caddr (car ttb)))	;***** start point *****
      (setq p00	 (list (car p00) (cadr p00) 0.0)
	    p000 p00
	    p01	 (polar p00 ang (+ (* dss gd kgb) (* dss zjj)))
	    p001 p01
      )
					;----- 取字符 --------------------
      (if (< dss 0.0)
	(setq hcd (+ (* (- hc 2) gd kgb) (* (- hc 3) zjj)))
					;*** 行长度 *** 
	(setq hcd (+ (* hc gd kgb) (* (- hc 1) zjj))) ;*** 行长度 *** 
      )
      (setq ft	 t
	    flag nil
      )
      (while ft
	(setq cc   (substr ttbb 1 1)
	      ttbb (substr ttbb 2)
	      ccm  (ascii cc)
	)
	(if (> ccm 175)			;*** 汉字 ***
	  (setq	cc   (strcat cc (substr ttbb 1 1))
		ttbb (substr ttbb 2)
		hh   gd
		nn   1.0
	  )
	  (progn
	    (setq hh (* 0.85 gd))	;*** 字母稍小 ***
	    (setq nn 0.95)
	    (if	(or (= ccm 49) (= ccm 105) (= ccm 108))
	      (setq nn 0.5)		;"1 i l =>小"
	    )
	  )
	)
	(setq hcdc (- hcd (- (car p01) (car p00))))

	(if (or (< hcdc (* 0.3 gd kgb)) flag)
					;--- 换行... ----------------------
	  (progn
	    (if	(= flag t)
					;--- 绝对换行 --------------------------
	      (progn
		(setq flag nil)
		(if hift
		  (command "text" p01 jiao cc)
		  (command "text" p01 hh jiao cc)
		)
		(setq p01 (polar p01 ang (+ (* nn hh kgb) zjj)))
	      )
					;--- 特殊情况不换行 --------------------------
	      (progn
					;--- 若是 "," "." ":" ";"... ----------
		(cond
		  ((or (= ccm 44) (= ccm 46) (= ccm 58) (= ccm 59))
		   (setq p01 (polar p01 ang (* 0.2 hh kgb)))
					;*** 稍靠后...
		   (if hift
		     (command "text" p01 jiao cc)
		     (command "text" p01 hh jiao cc)
		   )
		   (setq p01 (polar p000 (- ang (* 0.5 pi)) (+ gd hjj)))
		   (setq
		     p001 (polar p001 (- ang (* 0.5 pi)) (+ gd hjj))
		   )
		   (setq
		     p000 (polar p000 (- ang (* 0.5 pi)) (+ gd hjj))
		   )
		  )
					;--- 若是 "@"  -----------------------------
		  ((= ccm 64)		;*** "@" ***
		   (setq flag t)
		   (if hift
		     (command "text" p01 jiao cc)
		     (command "text" p01 hh jiao cc)
		   )
		   (HY_KZSJXZ (entlast) "BJ" 1000 "@")
		   (command "change" (entlast) "" "p" "c" "1" "")
		   (setq
		     p001 (polar p001 (- ang (* 0.5 pi)) (+ gd hjj))
		   )
		   (setq
		     p000 (polar p000 (- ang (* 0.5 pi)) (+ gd hjj))
		   )
		   (setq p01 p001)
		  )
					;--- 真换行 --------------------------------------------------
		  (t
		   (setq p01 (polar p000 (- ang (* 0.5 pi)) (+ gd hjj)))
		   (setq
		     p001 (polar p001 (- ang (* 0.5 pi)) (+ gd hjj))
		   )
		   (setq
		     p000 (polar p000 (- ang (* 0.5 pi)) (+ gd hjj))
		   )
		   (if hift
		     (command "text" p01 jiao cc)
		     (command "text" p01 hh jiao cc)
		   )
		   (setq p01 (polar p01 ang (+ (* nn hh kgb) zjj)))
		  )
		)
	      )
	    )
	  )
					;--- 不换行 ---------------------------------------------------
	  (progn
	    (cond
	      ((or (= ccm 44) (= ccm 46) (= ccm 58) (= ccm 59))
	       (setq p01 (polar p01 jiao (* 0.2 hh kgb)))
					;*** 稍靠后...
	       (if hift
		 (command "text" p01 jiao cc)
		 (command "text" p01 hh jiao cc)
	       )
	       (setq p01 (polar p01 ang (+ (* nn hh kgb) zjj)))
	      )
	      ((= ccm 64)		;*** "@" ***
	       (setq flag t)
	       (if hift
		 (command "text" p01 jiao cc)
		 (command "text" p01 hh jiao cc)
	       )
	       (HY_KZSJXZ (entlast) "BJ" 1000 "@")
	       (command "change" (entlast) "" "p" "c" "1" "")
	       (setq p001 (polar p001 (- ang (* 0.5 pi)) (+ gd hjj)))
	       (setq p000 (polar p000 (- ang (* 0.5 pi)) (+ gd hjj)))
	       (setq p01 p001)
	      )
	      (t
	       (if hift
		 (command "text" p01 jiao cc)
		 (command "text" p01 hh jiao cc)
	       )
	       (setq p01 (polar p01 ang (+ (* nn hh kgb) zjj)))
	      )
	    )
	  )
					;------------------------------------------
	)

	(if (= ttbb "")
	  (setq ft nil)
	)
      )					;*** end of (while ft ...
					;----- 恢复OLD KGB ---------------------------------------      
      (setq styb (subst (cons 41 kgbold) (cons 41 kgb) styb))
      (entmod styb)

      (command "redraw")
    )
    (prompt "\n没有选到文字。")
  )
  (princ)
)

;;---------------------------------
;; 1996.10.07 mon
;; 对表之第二元素排序 bb2px(ptb wc)
;; ptb  :  不一定是点表
;; wc   :  误差
;;---------------------------------
(defun bb2px (ptb wc / ptby b1 b2 ptyy yy pt yy0 ymin)

  (setq ptb (ptbypx ptb))
  (setq ptyy (mapcar 'cadr ptb))
  (setq ymin (apply 'min ptyy))

  (setq yy0 (- ymin (* 10.0 wc)))

  (foreach yy ptyy
    (if	(> (abs (- yy yy0)) wc)
      (progn
	(setq b1 nil)
	(foreach pt ptb
	  (if (<= (abs (- yy (cadr pt))) wc)
	    (setq b1 (cons pt b1))
	  )
	)
	(if (/= b1 nil)
	  (progn
	    (setq b1 (ptbxpx b1))
	    (setq b2 (append b1 b2))
	  )
	)
      )
    )
    (setq yy0 yy)
  )
  b2
)
;;;-----------------------------
;;; 1996.10.10 thu
;;; 选TEXT字型 
;;;-----------------------------
(defun szx (/ ss fhb stymb txt1b txt2b stym what1)

  (setq fhb (getsty))
  (setq	stymb (reverse (nth 0 fhb))
	txt1b (reverse (nth 1 fhb))
	txt2b (reverse (nth 2 fhb))
  )

  (if (not (new_dialog "sstyle" dcl_id))
    (exit)
  )

  (start_list "xstyle")
  (mapcar 'add_list stymb)
  (end_list)

  (action_tile
    "xstyle"
    "(setq stym (xstyle stymb txt1b txt2b))"
  )

  (action_tile "accept" "(done_dialog 1)")
  (action_tile "cancel" "(done_dialog 0)")

  (setq what1 (start_dialog))

  (if (= what1 1)
    (progn
      (set_tile "zxm" (strcat "字型名:" stym))
      (setvar "textstyle" stym)
    )
  )

)
;;------------------------------
;; 1996.10.10 thu
;; 取字型
;;------------------------------
(defun getsty (/ styb stym txt1 txt2)

  (setq styb (tblnext "STYLE" t))
  (setq	stym (list (strcase(cdr (assoc 2 styb))))
	txt1 (list (cdr (assoc 3 styb)))
	txt2 (list (cdr (assoc 4 styb)))
  )

  (while styb
    (setq styb (tblnext "STYLE"))
    (if	styb
      (progn
	(setq stym (append (list (strcase(cdr (assoc 2 styb)))) stym)
	      txt1 (append (list (cdr (assoc 3 styb))) txt1)
	      txt2 (append (list (cdr (assoc 4 styb))) txt2)
	)
      )
    )
  )
  (list stym txt1 txt2)

)

;;------------------------------
;; 1996.10.10 thu
;; 选字型
;;------------------------------
(defun xstyle (stymb txt1b txt2b / stym txt1m txt2m x y)

  (setq stym (atoi (get_tile $key)))
  (setq	txt1m (nth stym txt1b)
	txt2m (nth stym txt2b)
  )
  (setq	txt1m (cutext txt1m)
	txt1m (cutext txt1m)
  )
  (playsld txt1m "xw")
  (if (= txt2m "")
    (setq txt2m (strcat (HY_GetInstallDir) "shx/no-hz"))
  )
					;----- 显示幻灯 -------------  
  (setq x (dimx_tile "zw"))
  (setq y (dimy_tile "zw"))
  (start_image "zw")
  (fill_image 0 0 x y 19)
  (slide_image 0 0 x y txt2m)
  (end_image)


  (setq stym (nth stym stymb))

)
;;-------------------------------
;; 1996.10.11 fri
;; 去掉文件名中的扩展名 cutext(cc)
;;-------------------------------
(defun cutext (cc / ccb ll cct ccn ii)

  (if (wcmatch cc "*`.*")
    (progn
      (setq ccb cc)
      (setq ccn "")
      (setq ll (strlen ccb))
      (setq ii 1)
      (while (<= ii ll)
	(setq cct (substr ccb 1 1))
	(setq ccb (substr ccb 2))
	(if (/= cct ".")
	  (setq ccn (strcat ccn cct))
	  (setq ii ll)
	)
	(setq ii (1+ ii))
      )
    )
    (setq ccn cc)
  )
  ccn
)
;;;编辑文字
;;;-----------------------------
;;; 1996.10.16 wed
;;; 编缉成行 bjtxt.lsp
;;;-----------------------------
(defun bjtxt (/ ft ccb e eb lx cc p00 hh h0 sty styb flag kgb ccm hhh)

  (setvar "cmdecho" 0)
  (setvar "blipmode" 0)

  (setq hh (/ (Dl_GetTextHeight) (DL_GetDrawingFactor)))

  (setq sty (getvar "textstyle"))
  (setq styb (tblsearch "style" sty))
  (setq flag (cdr (assoc 40 styb)))	;*** fixed high ***
  (setq kgb (cdr (assoc 41 styb)))

  (setq ft t)
  (setq ccb "")
  (while ft

    (setq e (entsel "\n回车退出 / <选文字>:"))
    (if	(= e nil)
      (setq ft nil)
      (progn
	(setq e	 (car e)
	      eb (entget e)
	      lx (cdr (assoc 0 eb))
	)
	(if (= lx "TEXT")
	  (progn
	    (setq cc  (cdr (assoc 1 eb))
		  ccb (strcat ccb cc)
	    )
	    (redraw e 3)
	  )
	)
      )
    )
  )
  (if (/= ccb "")
    (progn
      (initget 1)
      (setq p00 (getpoint "\n文字起点:"))
      (setq ang 0.0)
      (setq h0 (getreal (strcat "\n字高:<" (rtos hh) ">")))
      (if (/= h0 nil)
	(setq hh h0)
      )

      (setq ft t)
      (while ft
	(setq cc " ")
	(while (= cc " ")
	  (setq cc (substr ccb 1 1))
	  (setq ccb (substr ccb 2))
	)
	(setq ccm (ascii cc))
	(if (> ccm 175)
	  (progn
	    (setq cc (strcat cc (substr ccb 1 1)))
	    (setq ccb (substr ccb 2))
	    (setq hhh hh)
	  )
	  (setq hhh (* 0.85 hh))
	)
	(if (= flag 0.0)
	  (command "text" p00 hhh (/ (* 180 ang) pi) cc)
	  (command "text" p00 (/ (* 180 ang) pi) cc)
	)
	(setq p00 (polar p00 ang (* hhh kgb)))

	(if (= ccb "")
	  (setq ft nil)
	)
      )
    )
  )
  (command "redraw")
  (princ)
)
;;;------------------------------
;;; 1996.10.17 thu
;;; 调整行间距 @chhjj.lsp
;;; (explode text is @chhjjj.lsp)
;;;------------------------------
(defun chhjj (/ ss hjj gd ii e eb p00 ttb tt p01 ee eeb pt p02 gd00)

  (setvar "cmdecho" 0)
  (setvar "blipmode" 0)
  (setvar "elevation" 0.0)
  (setvar "thickness" 0.0)

  (prompt "\n选择要调整的文字<空选返回>:")
  (setq ss (ssget (list (cons 0 "TEXT"))))
  (if ss
    (progn

      (setq hjj (getreal "\n行间距:<2.0>"))
      (if (= hjj nil)
	(setq hjj 2.0)
      )
      (setq gd (getvar "textsize"))
      (prompt "\n请稍候...")

      (setq ii 0)
      (repeat (sslength ss)
	(setq e	  (ssname ss ii)
	      eb  (entget e)
	      p00 (cdr (assoc 10 eb))
	      ttb (cons (append p00 (list e)) ttb)
	)
	(setq ii (1+ ii))
      )

      (setq ttb (bb3px ttb (* 0.3 gd)))	;*** 误差排序 ***

      (setq p00	(car (nth 0 ttb))
	    p00	(list (car p00) (cadr p00) (caddr p00))
      )
      (setq p01 p00)

      (foreach tt ttb
	(setq p00  (car tt)
	      ee   (nth 3 p00)
	      p00  (list (car p00) (cadr p00) (caddr p00))
	      gd00 (cdr (assoc 40 (entget ee)))
	)
	(setq p01 (list (car p00) (cadr p01) (caddr p00)))

	(foreach ee tt
	  (setq	ee  (nth 3 ee)
		eeb (entget ee)
		pt  (cdr (assoc 10 eeb))
		p02 (list (car pt) (cadr p01) (caddr p01))
	  )
	  (command "move" ee "" pt p02)
	)

	(setq p01 (polar p01 (* 1.5 pi) (+ gd00 hjj)))
      )
      (command "redraw")
    )
  )
  (princ)
)
;;;------------------------------
;;; 1996.10.17 thu
;;; 调整文字间距 @chzjj.lsp
;;;------------------------------
(defun chzjj (/ jiao ang ss zjj gd ii e eb p00 ttb tt ee)

  (setvar "cmdecho" 0)
  (setvar "blipmode" 0)
  (setvar "elevation" 0.0)
  (setvar "thickness" 0.0)
  (setq jiao 0.0)			;*** jiao, ...
  (setq ang (/ (* jiao pi) 180.0))

  (prompt "\n选择要调整的文字<空选返回>:")
  (setq ss (ssget (list (cons 0 "TEXT"))))
  (if ss
    (progn

      (setq zjj (getreal "\n字间距:<0.5>"))
      (if (= zjj nil)
	(setq zjj 0.5)
      )
      (setq gd (getvar "textsize"))

      (setq ii 0)
      (repeat (sslength ss)
	(setq e	  (ssname ss ii)
	      eb  (entget e)
	      p00 (cdr (assoc 10 eb))
	      ttb (cons (append p00 (list e)) ttb)
	)
	(setq ii (1+ ii))
      )

      (setq ttb (bb3px ttb (* 0.3 gd)))	;*** 误差排序 ***

      (foreach tt ttb
	(setq p00 (car tt)
	      p00 (list (car p00) (cadr p00) (caddr p00))
	)
	(foreach ee tt
	  (setq ee (nth 3 ee))
	  (setq p00 (wtext ee p00))
	)
      )
      (command "erase" ss "")
      (command "redraw")
    )
  )
  (princ)
)
;;------------------------------
;; 1996.10.18 fri
;; write text --(wtext ee p00)
;; ee --- entity
;; p00 -- start point
;; return => pt : next start point
;;------------------------------
(defun wtext (e	    p00	  /	eb    ttb   sty	  gd0	kgb   hift
	      ft    cc	  ccm	nn    p00   styb  kgbold      txt1
	      txt2  txtb
	     )

  (setq	eb  (entget e)
	ttb (cdr (assoc 1 eb))
	sty (cdr (assoc 7 eb))
	gd0 (cdr (assoc 40 eb))
	kgb (cdr (assoc 41 eb))
  )
					;----- 保留OLD KGB --------------------------------
  (setq styb (tblsearch "style" sty))
  (setq kgbold (cdr (assoc 41 styb)))
					;--- kgb 不同时须设style ---------      
  (if (equal kgbold kgb 0.05)
    (setvar "textstyle" sty)
    (progn
					;(setq txt1 (cdr (assoc 3 styb))
					;      txt2 (cdr (assoc 4 styb))
					;      txtb (strcat txt1 "," txt2)
					;)
					;(command "style" sty txtb "0.0" kgb "" "" "")
      (command "style" sty "" "0.0" kgb "" "" "")
      (if (/= (getvar "cmdnames") "")
	(command "")
      )
    )
  )
					;--------------------------------------------------
  (setq hift (highft))

  (setq ft t)
  (while ft
    (setq cc  (substr ttb 1 1)
	  ttb (substr ttb 2)
	  ccm (ascii cc)
    )
    (if	(> ccm 175)			;*** 汉字 ***
      (setq cc	(strcat cc (substr ttb 1 1))
	    ttb	(substr ttb 2)
	    nn	1.0
      )
      (progn
	(setq nn 0.95)
	(if (or (= ccm 49) (= ccm 105) (= ccm 108))
	  (setq nn 0.5)			;"1 i l =>小"
	)
      )
    )

    (if	hift
      (command "text" p00 jiao cc)
      (command "text" p00 gd0 jiao cc)
    )
    (setq p00 (polar p00 ang (+ (* nn gd0 kgb) zjj)))

    (if	(= ttb "")
      (setq ft nil)
    )
  )
  p00
)
;;----------------------------------------
;;---------------------------------------------
;; 1996.10.07 mon
;; 对表之第二元素排序 bb2px(ptb wc)
;; ptb  :  不一定是点表
;; wc   :  误差
;; return => ((...) (...) ...) Y相同为一子表
;;---------------------------------------------
(defun bb3px (ptb wc / ptby b1 b2 ptyy yy pt yy0 ymin)

  (setq ptb (ptbypx ptb))
  (setq ptyy (mapcar 'cadr ptb))
  (setq ymin (apply 'min ptyy))

  (setq yy0 (- ymin (* 10.0 wc)))

  (foreach yy ptyy
    (if	(> (abs (- yy yy0)) wc)
      (progn
	(setq b1 nil)
	(foreach pt ptb
	  (if (<= (abs (- yy (cadr pt))) wc)
	    (setq b1 (cons pt b1))
	  )
	)
	(if (/= b1 nil)
	  (progn
	    (setq b1 (ptbxpx b1))
					;(setq b2 (append b1 b2))   ;*** bb2px =>(.....)
	    (setq b2 (append (list b1) b2))
					;*** bb3px =>((...) (...) ...)
	  )
	)
      )
    )
    (setq yy0 yy)
  )
  b2
)
;;;------------------------------
;;; 1996.10.25 thu
;;; modi 1998.07.02
;;; 西文字高调整 
;;;------------------------------
(defun gxwgd (/	gdxs h00 ang jiao ss ii	e eb ttb p00 hhh kgb ft	cc ccm
	      xs zxm zxmold)

  (HY_SV)
  (setq zxmold (getvar "textstyle"))

  (prompt "\n选择要调整的文字<空选返回>:")
  (setq ss (ssget (list (cons 0 "TEXT"))))
  (if ss
    (progn
      (setq gdxs (getreal (strcat "\n西文高度放大系数:<0.8>")))
      (if (= gdxs nil)
	(setq gdxs 0.8)
      )

      (prompt "\n请稍候...")
					;(command "undo" "m")  ;*** mark ***
      (HY_UndoM)

      (setq ii 0)
      (repeat (sslength ss)
	(setq e	   (ssname ss ii)
	      eb   (entget e)
	      ttb  (cdr (assoc 1 eb))
	      p00  (cdr (assoc 10 eb))
	      hhh  (cdr (assoc 40 eb))
	      kgb  (cdr (assoc 41 eb))
	      ang  (cdr (assoc 50 eb))
	      jiao (* (/ ang pi) 180.0)
	      zxm  (cdr (assoc 7 eb))
	)
	(setvar "textstyle" zxm)

	(setq ft t)
	(while ft
	  (setq	cc  (substr ttb 1 1)
		ttb (substr ttb 2)
		ccm (ascii cc)
	  )
	  (if (> ccm 175)		;*** 汉字 ***
	    (setq cc  (strcat cc (substr ttb 1 1))
		  ttb (substr ttb 2)
		  h00 hhh
		  xs  1.0
	    )
	    (progn
	      (setq h00	(* gdxs hhh)
		    xs	1.0
	      )
	      (if (or (= ccm 49) (= ccm 105) (= ccm 108))
		(setq xs 0.7)		;"1 i l =>小"
	      )
	    )
	  )
	  (if (highft)
	    (command "text" p00 jiao cc)
	    (command "text" p00 h00 jiao cc)
	  )

	  (setq p00 (polar p00 ang (* xs h00 kgb)))

	  (if (= ttb "")
	    (setq ft nil)
	  )
	)				;*** end of (while ft ...

	(setq ii (1+ ii))
      )
      (command "erase" ss "")
      (command "redraw")
    )
    (prompt "\n没有选到文字。")
  )

  (setvar "textstyle" zxmold)
  (HY_RV)
  (princ)
)
;;-------------------------------
;; 1996.10.17 thu
;; 有无高度 highft ==>T/nil
;;-------------------------------
(defun highft (/ styb hh ft)

  (setq styb (tblsearch "style" (getvar "textstyle")))
  (setq hh (cdr (assoc 40 styb)))

  (if (equal hh 0.0 0.1)
    (setq ft nil)
    (setq ft t)
  )
  ft
)
(defun chtxt (/ y old new ss len n s0 s1 tex xx)
  (setvar "blipmode" 0)
  (setvar "cmdecho" 0)
  (setq y1 t)
  (while y1

    (setq old (getstring "\n回车退出 /　请输入原字符:"))

    (if	(= old "")
      (setq y1 nil)
      (progn
	(setq y t)
	(while y
	  (setq new (getstring "\n请输入新字符:"))
	  (if (/= old "")
	    (setq y nil)
	  )
	)
	(prompt "\n选修改范围:")
	(setq ss (ssget '((0 . "TEXT"))))
	(if (/= ss nil)
	  (progn

	    (setq len (strlen old))
	    (setq n 0)
	    (while (< n (sslength ss))
	      (setq s0 (ssname ss n))
	      (setq s1 (entget s0))
	      (setq tex (cdr (assoc 1 s1)))
	      (setq xx (strsubst tex old new))
	      (command "change" s0 "" "" "" "" "" "" xx)
	      (setq n (+ n 1))
	    )
	  )
	)

      )
    )
  )
  (princ)
)

(defun strsubst(strvar strold strnew / str str_ret len_old num_find )
 (setq str strvar)
 (if (= strold "")
  (setq str_ret strvar)
  (progn
     (setq len_old (strlen strold) str_ret "")
     (while (setq num_find (vl-string-search strold str))
       (if (= num_find 0)
         (setq str_ret (strcat str_ret strnew) )
         (setq str_ret (strcat str_ret (substr str 1 num_find) strnew) )
       )
       (setq str (substr str (+ num_find len_old 1)) )
		 )
		 (if str
		   (setq str_ret (strcat str_ret str))
		 )
	 )
 )
 str_ret
)    ;end of defun
;;;-----------------------------
;;; 1996.10.19 sat modify
;;; 改字宽
;;;-----------------------------
;;(defun chwidth (/ ss wid ii e eb)
;;
;;  (setvar "cmdecho" 0)
;;  (setvar "blipmode" 0)
;;
;;  (prompt "\n选取文字:")
;;  (setq ss (ssget (list (cons 0 "TEXT"))))
;;  (if ss
;;    (progn
;;      (setq wid (getreal "\n输入新的宽度因子:<0.7>"))
;;      (if (= wid nil)
;;	(setq wid 0.7)
;;      )
;;
;;      (setq ii 0)
;;      (repeat (sslength ss)
;;	(setq e	 (ssname ss ii)
;;	      eb (entget e)
;;	      eb (subst (cons 41 wid) (assoc 41 eb) eb)
;;	)
;;	(entmod eb)
;;	(setq ii (1+ ii))
;;      )
;;    )
;;    (prompt "\n没有选中文字。")
;;  )
;;  (princ)
;;)
(defun chwidth (/    ss	 y    y1   dh	yy   ss1  s    s1   n	 slen
	       c    h	 zh   dd   k	h1   c1	  pw   p1   p2	 sca
	       zh0  sca1 ppg  uctr wid
	      )
  (szload pub_save_var "wwpublic")
  (pub_save_var)
  (if pccbb
    ;;(setq sca (dbl))
    (setq sca (DL_getDrawingfactor))
    (setq sca 1.0)
  )
  (setq	k    1
	uctr (HY_ClearUNDO)
  )
  (setq yy t)
  (while yy
    (initget "X C H S A U")
    (setq dh
	   (getkword
	     "\n回车退出 / 回退 U/ 某型字 X/ 某层字 C/ 某高字 H/ 选取字 S/ 所有字 A:"
	   )
    )
    (if	dh
      (progn
	(setq k 1)
	(cond
	  ((= dh "U")
	   (setq ss nil)
	   (if (<= (getvar "undomarks") uctr)
	     (prompt "\n已全部回退!")
	     (HY_UndoB)
	   )
	  )
	  ((= dh "S")
	   (setq ss (ssget '((0 . "TEXT"))))
	  )
	  ((= dh "A") (setq ss (ssget "X" '((0 . "TEXT")))))
	  ((= dh "C")
	   (setq y t)
	   (while y
	     (while (null (setq s (car (entsel "\n选字样:")))))
	     (if (= (cdr (assoc 0 (entget s))) "TEXT")
	       (setq y nil)
	       (prompt "\n未选中字重选!")
	     )
	   )
	   (setq c (strcase(cdr (assoc 8 (entget s)))))
	   (setq h1 (cdr (assoc 40 (entget s))))
	   (setq c1 (getstring (strcat "\n字层" "<" c ">:")))
	   (if (/= c1 "")
	     (setq c (strcase c1))
	   )
	   (setq ss (ssget "X" (list (cons 8 c) '(0 . "TEXT"))))
	  )
	  ((= dh "X")
	   (setq y t)
	   (while y
	     (while (null (setq s (car (entsel "\n选字样:")))))
	     (if (= (cdr (assoc 0 (entget s))) "TEXT")
	       (setq y nil)
	       (prompt "\n未选中字重选!")
	     )
	   )
	   (setq c (cdr (assoc 7 (entget s))))
	   (setq h1 (cdr (assoc 40 (entget s))))
	   (setq c1 (getstring (strcat "\n字型" "<" c ">:")))
	   (if (/= c1 "")
	     (setq c (strcase c1))
	   )
	   (setq ss (ssget "X" (list (cons 7 c) '(0 . "TEXT"))))
	  )
	  ((= dh "H")
	   (setq y t)
	   (while y
	     (while (null (setq s (car (entsel "\n选字样:")))))
	     (if (= (cdr (assoc 0 (entget s))) "TEXT")
	       (setq y nil)
	       (prompt "\n未选中字重选!")
	     )
	   )
	   (setq h (cdr (assoc 40 (entget s))))
	   (setq
	     h1	(getreal
		  (strcat "\n原字高" "<" (rtos (/ h sca) 2 2) ">:")
		)
	   )
	   (if (/= h1 nil)
	     (setq h (* h1 sca))
	   )
	   (setq ss
		  (ssget "X" (list '(0 . "TEXT") '(-4 . "=") (cons 40 h)))
	   )
	  )
	)
	(if (/= ss nil)
	　(progn
	　　(HY_UndoM)
	    (initget (+  2 4))
      　　　(setq wid (getreal "\n输入新的宽度因子:<0.7>"))
      　　　(if (= wid nil)
	　　　　(setq wid 0.7)
     　　　 )
            (setq n 0)
            (while (< n (sslength ss))
	      (setq s (ssname ss n))
	      (setq s1 (entget s))
	      (setq s1	(subst (cons 41 wid) (assoc 41 s1) s1))
	      (entmod s1)
	      (setq n (+ n 1))
	    )
    　　　)
	  
	)
      )
      (setq yy nil)
    )
  )
  (pub_re_var)
  (princ)
)

(defun dwchte (/    ss	 y    y1   dh	yy   ss1  s    s1   n	 slen
	       c    h	 zh   dd   k	h1   c1	  pw   p1   p2	 sca
	       zh0  sca1 ppg  uctr
	      )
  (szload pub_save_var "wwpublic")
  (pub_save_var)
  (if pccbb
    ;;(setq sca (dbl))
    (setq sca (DL_getDrawingfactor))
    (setq sca 1.0)
  )
  (setq	k    1
	uctr (HY_ClearUNDO)
  )
  (setq yy t)
  (while yy
    (initget "X C H S A U")
    (setq dh
	   (getkword
	     "\n回车退出 / 回退 U/ 某型字 X/ 某层字 C/ 某高字 H/ 选取字 S/ 所有字 A:"
	   )
    )
    (if	dh
      (progn
	(setq k 1)
	(cond
	  ((= dh "U")
	   (setq ss nil)
	   (if (<= (getvar "undomarks") uctr)
	     (prompt "\n已全部回退!")
	     (HY_UndoB)
	   )
	  )
	  ((= dh "S")
	   (setq ss (ssget '((0 . "TEXT"))))
	  )
	  ((= dh "A") (setq ss (ssget "X" '((0 . "TEXT")))))
	  ((= dh "C")
	   (setq y t)
	   (while y
	     (while (null (setq s (car (entsel "\n选字样:")))))
	     (if (= (cdr (assoc 0 (entget s))) "TEXT")
	       (setq y nil)
	       (prompt "\n未选中字重选!")
	     )
	   )
	   (setq c (strcase(cdr (assoc 8 (entget s)))))
	   (setq h1 (cdr (assoc 40 (entget s))))
	   (setq c1 (getstring (strcat "\n字层" "<" c ">:")))
	   (if (/= c1 "")
	     (setq c (strcase c1))
	   )
	   (setq ss (ssget "X" (list (cons 8 c) '(0 . "TEXT"))))
	  )
	  ((= dh "X")
	   (setq y t)
	   (while y
	     (while (null (setq s (car (entsel "\n选字样:")))))
	     (if (= (cdr (assoc 0 (entget s))) "TEXT")
	       (setq y nil)
	       (prompt "\n未选中字重选!")
	     )
	   )
	   (setq c (cdr (assoc 7 (entget s))))
	   (setq h1 (cdr (assoc 40 (entget s))))
	   (setq c1 (getstring (strcat "\n字型" "<" c ">:")))
	   (if (/= c1 "")
	     (setq c (strcase c1))
	   )
	   (setq ss (ssget "X" (list (cons 7 c) '(0 . "TEXT"))))
	  )
	  ((= dh "H")
	   (setq y t)
	   (while y
	     (while (null (setq s (car (entsel "\n选字样:")))))
	     (if (= (cdr (assoc 0 (entget s))) "TEXT")
	       (setq y nil)
	       (prompt "\n未选中字重选!")
	     )
	   )
	   (setq h (cdr (assoc 40 (entget s))))
	   (setq
	     h1	(getreal
		  (strcat "\n原字高" "<" (rtos (/ h sca) 2 2) ">:")
		)
	   )
	   (if (/= h1 nil)
	     (setq h (* h1 sca))
	   )
	   (setq ss
		  (ssget "X" (list '(0 . "TEXT") '(-4 . "=") (cons 40 h)))
	   )
	  )
	)
	(if (/= ss nil)
	  (progn
	    (if	(and (= c1 "") (/= dh "A") (/= dh "H") (numberp h1))
	      (prompt (strcat "\n样字高:" (rtos (/ h1 sca) 2 2)))
	    )
	    (HY_UndoM)
	    ;;; 修改：提示老字高，并亮显第一个实体 --- start
	    (setq firstEnt (ssname ss 0))
	    (redraw firstEnt 3)
	    (setq zh_old (cdr (assoc 40 (entget firstEnt))))
	    (setq strPrompt (strcat "\n新字高" "<" (rtos (/ zh_old sca) 2 2) ">:"))
	    (initget (+ 2 4))
	    (setq zh (getreal strPrompt))
	    (if (null zh)
	      (setq zh zh_old)
	    )
	    ;;; 修改：提示老字高，并亮显第一个实体  -- end		
	    (setq n 0)
	    (while (< n (sslength ss))
	      (setq s (ssname ss n))
	      (setq s1 (entget s))
	      (setq zh0	(cdr (assoc 40 s1))
		    ppg	(cdr (assoc 10 s1))
	      )
	      (setq sca1 (/ (* sca zh) zh0))
	      (command "scale" s "" ppg sca1)
	      (setq n (+ n 1))
	    )
	  )
	)
      )
      (setq yy nil)
    )
  )
  (pub_re_var)
  (princ)
)
;;;-----------------------------
;;; 1996.10.16 wed modify
;;; 分解文字
;;;-----------------------------
(defun eptext (/ ss ssl sn p1 cc
	       sty ang dd stl stn styold styb h0 kgbold)
  (setvar "cmdecho" 0)
  (setvar "blipmode" 0)
  (setq styold (getvar "textstyle"))

  (prompt "\n选择文字:")
  (setq ss (ssget (list (cons 0 "TEXT"))))
  (if ss
    (progn
      (setq ssl (sslength ss))
      (setq sn 0)

      (while (< sn ssl)
	(setq sent (ssname ss sn))
	(setq p1 (cdr (assoc 10 (entget sent))))
	(setq cc (cdr (assoc 1 (entget sent))))
	(setq h (cdr (assoc 40 (entget sent))))
	(setq sty (cdr (assoc 7 (entget sent))))
	(setq ang (cdr (assoc 50 (entget sent))))
	(setq wid (cdr (assoc 41 (entget sent))))

					;----- 保留OLD KGB --------------------------------
	(setq styb (tblsearch "style" sty))
	(setq h0 (cdr (assoc 40 styb)))	;*** fixed high ***
	(setq kgbold (cdr (assoc 41 styb)))
					;--- kgb 不同时须设style ---------      
	(if (equal kgbold wid 0.05)
	  (setvar "textstyle" sty)
	  (progn
	    (command "style" sty "" "0.0" wid "" "" "")
	    (if	(/= (getvar "cmdnames") "")
	      (command "")
	    )
	  )
	)
	(setq styb (tblsearch "style" sty))
	(setq h0 (cdr (assoc 40 styb)))	;*** fixed high ***
					;--------------------------------------------------
	(command "erase" sent "")

	(setq dd (* h wid))
	(setq stl (strlen cc))
	(setq stn 1)
	(while (<= stn stl)
	  (setq	scc (substr cc stn 1)
		dc  1
	  )
	  (if (> (ascii scc) 175)
	    (setq scc (substr cc stn 2)
		  dc  2
	    )
	  )
	  (if (= h0 0.0)
	    (command "text" p1 h (/ (* 180 ang) pi) scc)
	    (command "text" p1 (/ (* 180 ang) pi) scc)
	  )
	  (setq p1 (polar p1 ang dd))
	  (setq stn (+ dc stn))
	)
	(setq sn (1+ sn))
      )
    )
    (prompt "\n没有选中文字。")
  )

  (setvar "textstyle" styold)
  (setvar "cmdecho" 1)
  (setvar "blipmode" 1)
  (princ)
)
;;;modi 1998.05.06
(defun exchg (/	en17 txt17 tt17	li17 nwen17 ent17 lit17	nwent17	uctr
	      entb loop)
  (setvar "cmdecho" 0)
  (setq	loop t
	uctr (HY_ClearUNDO)
  )
  (while loop
    (setq entb (HY_SelSingleEnt	"\n回车退出 / 回退 U / 选择文本1:"
			"TEXT"
			nil
			nil
			"U"
	       )
    )
    (cond
      ((null entb) (setq loop nil))
      ((= entb "RETURN") (princ "\n不是文本,选择无效!"))
      ((= entb "U")
       (if (<= (getvar "undomarks") uctr)
	 (prompt "\n已全部回退!")
	 (HY_UndoB)
       )
      )
      (t
       (setq en17   (entget (car entb))
	     txt17  (cdr (setq li17 (assoc 1 en17)))
	     txtst7 (assoc 7 en17)
       )
       (setq entb (HY_SelSingleEnt "\n选择文本2:" "TEXT" nil nil nil))
       (cond
	 ((null entb) (setq loop nil))
	 ((= entb "RETURN") (princ "\n不是文本,选择无效!"))
	 (t
	  (setq	ent17 (entget (car entb))
		tt17  (cdr (setq lit17 (assoc 1 ent17)))
		ttst7 (assoc 7 ent17)
	  )
	  (HY_UndoM)
	  (setq nwen17 (subst (cons 1 tt17) li17 en17))
	  (setq nwen17 (subst ttst7 (assoc 7 nwen17) nwen17))
	  (entmod nwen17)

	  (setq nwent17 (subst (cons 1 txt17) lit17 ent17))
	  (setq nwent17 (subst txtst7 (assoc 7 nwent17) nwent17))
	  (entmod nwent17)
	 )
       )
      )
    )
  )
  (princ)
)


;;;----------------------------------------------------------------------------------
;;;tf tag var cnt key n exist为临时变量，用于控制循环
;;;tblstyle一种样式数据，stylname样式名,oldstyle存储原样式名
;;;entname entdata实体名，实体数据
;;;ttfsty存储TrueType字体的样式名 ftext字体文件名 
;;;----------------------------------------------------------------------------------
;;;注意：对于有的truetype字体若没有对应的ttf文件，会查找不到，该程序没有处理这种情况
(defun zxzh (/	      tf       tag	var	 cnt	  key
	     n	      tblstyle stylname	exist	 oldstyle entname
	     entdata  ttfsty   ftext	hzm
	    )
   ;;;
   ;;;循环选择文字
  (pub_save_var)
  (setq tf t)
  (while tf
    (initget "H E")
    (setq key
	   (getkword 
	     "\n 退出 E / 恢复truetype样式 H / <选择要显示为细线方式的文字>:"
	   )
    )
    ;;注意程序修改时不要漏，检查一下
    (cond
      ;;;恢复truetype样式字体
      ((= key "H")
       (setq
	 ss (ssget
	      '((-3 ("OLDSTYLE")) (7 . "HY_THIN") (0 . "TEXT,MTEXT"))
	    )
       )
       (setq cnt 0)
       (if (/= ss nil)
	 (setq cnt (sslength ss))
       )
       (setq n 0)
       ;;;开始恢复
       (repeat cnt
	 (setq entname (ssname ss n))
	 (setq n (1+ n))
	 (setq entdata (entget entname '("OLDSTYLE")))
	 (setq oldstyle (cdr (assoc 1000 (cdadr (assoc -3 entdata)))))
         ;;;更新文字样式
	 (setq entdata (entget entname))
	 (if (/= oldstyle nil)
	   (progn
	     ;;可以直接使用kzsjxz，他也可以用来修正常规数据
	     ;;(kzsjxz ent nil 7 style)
	     (setq entdata (subst (cons 7 oldstyle)
				  (assoc 7 entdata)
				  entdata
			   )
	     )
	     (entmod entdata)
	   );end of progn
	 );end of if
       );end of repeat
      );第一个分支完

      ;;;选择文字使其转化为细线方式
      ((NULL key)
       ;;;判断是否存在hy_thin样式的字体
       (setq var t
	     tag t
	     exist nil
       )
       (setq ttfsty "")
       (while var
	 ;;循环变量var控制有问题
	 (setq tblstyle (tblnext "STYLE" tag))
	 (if (/= tblstyle nil)
	   (progn
	     (setq stylname (cdr (assoc 2 tblstyle)))
	     ;;得到样式文字类型文件
	     (setq ftext (cdr (assoc 3 tblstyle)))
	   )
	   (setq var nil)
	 )
         ;;;如果是Truetype字体就记录其样式名,作为过滤条件
	 (setq hzm nil)
	 (if (> (strlen ftext) 3)
	   (setq hzm (substr ftext (- (strlen ftext) 3) 4))
	 )

	 (if (and hzm (= (strcase hzm) ".TTF"))
	   (setq ttfsty (strcat ttfsty "," stylname))
	 );end of if
	 (if (= stylname "HY_THIN")
	   (setq exist t)
	 )
	 (setq tag nil)
       );end of while



       ;;;
       ;;;如果HY_THIN不存在则创建 
       (if (NULL exist)
	 (command "STYLE" "HY_THIN" "txt,hztxt" 0 1 0 "N" "N" "N")
       )
       ;;;得到选择集中实体及个数
       (setq ss (ssget (list (cons 7 ttfsty) (cons 0 "TEXT,MTEXT"))))
       (setq cnt 0)
       (if (/= ss nil)
	 (setq cnt (sslength ss))
       )
       (setq n 0)
       ;;;字体开始转换
       (repeat cnt
	 (setq entname (ssname ss n))
	 (setq n (1+ n))
         ;;;判断选择实体是否是字体
	 (setq entdata (entget entname))
	 (if (/= (cdr (assoc 7 entdata)) "HY_THIN")
	   (progn
             ;;;保存文字旧样式
	     (setq oldstyle (cdr (assoc 7 entdata)))
	     (hy_kzsjxz entname "OLDSTYLE" 1000 oldstyle)
             ;;;更新文字样式为HY_THIN
	     (setq entdata (subst (cons 7 "HY_THIN")
				  (assoc 7 entdata)
				  entdata
			   )
	     )
	     (entmod entdata)
	   );end of progn
	 );end of if 
       );end of repeat
      )
      ;;;第二个分支完
      ;;;如果执行了后两种方式就结束循环
      ((= key "E")
       (setq tf nil)
      )
      ;;;第三分支完
    );end of cond
  );end of while
  (pub_re_var)
);end of defun
;
;
