[讨论]：如何更改多种高度和角度原有文字的宽度比例

沙粒 · 发表于 2003-5-9 10:36:35

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

如果感到原有DWG文件中的字体宽高比不合适，而文件中的字体又各自具有不同的文字高度和转角需要保持，怎样能更有效地仅仅改变这些文字的宽度比例？比如将宽度比例全部由1.0改为0.7。

请各位大师发表高见！

XLLI8704 · 发表于 2003-5-9 12:34:40

不知你用的CAD版本，如果是2000以上可以用属性对话框加过滤一次搞定

zhynt · 发表于 2003-5-9 13:02:29

以前在Ｒ１４中的附加程序（Ｂｏｎｕｓ）中有一个chtext.lsp程序，其命令为ｃｈｔ，可以解决这个问题，它还可以进行文本的替换等。

gyd · 发表于 2003-5-9 17:33:05

对字体的宽高比进行设置可以

沙粒 · 发表于 2003-5-12 22:18:29

最初由 XLLI8704 发布
[B]不知你用的CAD版本，如果是2000以上可以用属性对话框加过滤一次搞定 [/B]

谢谢！
我用的是2002版。但不知你说的“用属性对话框加过滤一次搞定”怎么做，盼赐教。
这个问题可能困惑许多CAD爱好者，也替大家谢谢你！

ahlzl · 发表于 2003-5-12 22:37:55

这样如何：

上上签 · 发表于 2003-5-12 23:38:07

个人觉得，首先用style设置一个文字样式，觉得不合适时，再使用style命令，在文字样式对话框里面更改文字的高宽比，概念更清晰!
并且，style命令还可以改变文字的字体形式，配合rename命令，当字体改变时，再改变文字样式的名字，岂不更妙？

沙粒 · 发表于 2003-5-15 11:57:14

改变单串文字的宽度比例，CAD应用者可能都掌握。
关键是想修改一个已经做好的DWG文件中的许许多多各自具有不同高度和转角的文字的宽度比例。

在文字样式中修改不会对图中原有文字宽度比例起作用。

而用属性匹配，又会改变各文字分别具有的高度和转角属性。

请各位真正大师级用户发表高见！

真诚希望XLLI8704兄和zhynt斑竹详细说明一下你们的做法。

yxc · 发表于 2003-5-15 12:23:36

用ahlzl 提出的方法即可解决，虽然他的演示不如你说的复杂，但是操作是一样的，只要过滤出所有文字，指定一个公共的宽度系数（如0.7）即可

高山 · 发表于 2003-5-15 15:15:21

我把这个过程再做一遍（我的第一次Flash cam演示，弄得不好请包涵）

halibt · 发表于 2003-5-15 18:49:58

最初由 zhynt 发布
[B]以前在Ｒ１４中的附加程序（Ｂｏｎｕｓ）中有一个chtext.lsp程序，其命令为ｃｈｔ，可以解决这个问题，它还可以进行文本的替换等。 [/B]

是这个吗？

; Next available MSG number is 83
; MODULE_ID CHTEXT_LSP_
; $Header: /sedona/develop/support/chtext.lsp 8 4/29/97 5:35p Derrl $
;;;
;;; CHTEXT.lsp - change text
;;;
;;;
;;; Permission to use, copy, modify, and distribute this software
;;; for any purpose and without fee is hereby granted, provided
;;; that the above copyright notice appears in all copies and
;;; that both that copyright notice and the limited warranty and
;;; restricted rights notice below appear in all supporting
;;; documentation.
;;;
;;; AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.
;;; AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF
;;; MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE. AUTODESK, INC.
;;; DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE
;;; UNINTERRUPTED OR ERROR FREE.
;;;
;;; Use, duplication, or disclosure by the U.S. Government is subject to
;;; restrictions set forth in FAR 52.227-19 (Commercial Computer
;;; Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii)
;;; (Rights in Technical Data and Computer Software), as applicable.
;;;
;;;--------------------------------------------------------------------------;
;;; DESCRIPTION
;;; This is a "text processor" which operates in a global manner
;;; on all of the text entities that the user selects; i.e., the
;;; Height, Justification, Location, Rotation, Style, Text, and
;;; Width can all be changed globally or individually, and the
;;; range of values for a given parameter can be listed.
;;;
;;; The command is called with CHT from the command line at which
;;; time the user is asked to select the objects to change.
;;;
;;; Select text to change.
;;; Select objects:
;;;
;;; If nothing is selected the message "ERROR: Nothing selected."
;;; is displayed and the command is terminated. If more than 25
;;; entities are selected the following message is displayed while
;;; the text entities are sorted out from the non-text entities.
;;; A count of the text entities found is then displayed.
;;;
;;; Verifying the selected entities...
;;; nnn text entities found.
;;; CHText: Height/Justification/Location/Rotation/Style/Text/Undo/Width:
;;;
;;; A typical example of the prompts you may encounter follows:
;;;
;;; If you select a single text entity to change and ask to change
;;; the height, the prompt looks like this:
;;;
;;; CHText: Height/Justification/Location/Rotation/Style/Text/Undo/Width:
;;; New text height for text entity. <0.08750000>:
;;;
;;; If you select more than one text entity to change and ask to change
;;; the height, the prompt looks like this:
;;;
;;; CHText: Height/Justification/Location/Rotation/Style/Text/Undo/Width:
;;; Individual/List/<New height for all entities>:
;;;
;;; Typing "L" at this prompt returns a prompt showing you the range of
;;; values that you are using for your text.
;;;
;;; Height -- Min: 0.05000000 Max: 0.10000000 Ave: 0.08392857
;;;
;;; Typing "I" at this prompt puts you in a loop, processing the text
;;; entities you have selected one at a time, and giving the same prompt
;;; you get for a single text entity shown above.
;;;
;;; Pressing ENTER at this point puts you back at the Command: prompt.
;;; Selecting any of the other options allows you to change the text
;;; entities selected.
;;;
;;;---------------------------------------------------------------------------;
(defun cht_Main ( / sset opt ssl nsset temp unctr ct_ver sslen style hgt rot
txt ent loc loc1 just-idx justp justq orthom
cht_ErrorHandler cht_OrgError cht_OrgCmdecho
cht_OrgTexteval cht_OrgHighlight)
;; Reset if changed
(setq ct_ver "2.00")
;; Internal error handler defined locally
(defun cht_ErrorHandler (s)
(if (/= s "函数已取消")
(if (= s "quit / exit abort")
(princ)
(princ (strcat "\n错误: " s))
)
)
(eval (read U:E))
;; Reset original error handler if there
(if cht_OrgError (setq *error* cht_OrgError))
(if temp (redraw temp 1))
(ai_undo_off) ;; restore undo state
(if cht_OrgCmdecho (setvar "cmdecho" cht_OrgCmdecho))
(if cht_OrgTexteval (setvar "texteval" cht_OrgTexteval))
(if cht_OrgHighlight (setvar "highlight" cht_OrgHighlight))
(princ)
)
;; Set error handler
(if *error*
(setq cht_OrgError *error*
*error* cht_ErrorHandler)
(setq *error* cht_ErrorHandler)
)
;; Set undo groups and ends with (eval(read U:G)) or (eval(read U:E))
(setq U:G "(command "_.undo" "_group")"
U:E "(command "_.undo" "_en")"
)
(ai_undo_on) ;; enable undo
(setq cht_OrgCmdecho (getvar "cmdecho"))
(setq cht_OrgHighlight (getvar "highlight"))
(setvar "cmdecho" 0)
(princ (strcat "\n修改文字，Version "
ct_ver
", 版权(c) 1997 Autodesk, Inc."))
(prompt "\n选择要修改的注释对象。")
(setq sset (ai_aselect))
(if (null sset)
(progn
(princ "\n未选择对象。")
(exit)
)
)
;; Validate selection set
(setq ssl (sslength sset)
nsset (ssadd))
(if (> ssl 25)
(princ "\n验证选择的对象...")
)
(while (> ssl 0)
(setq temp (ssname sset (setq ssl (1- ssl))))
(if (or
(= (cdr (assoc 0 (entget temp))) "TEXT")
(= (cdr (assoc 0 (entget temp))) "ATTDEF")
(= (cdr (assoc 0 (entget temp))) "MTEXT")
)
(ssadd temp nsset)
)
)
(setq ssl (sslength nsset)
sset nsset
unctr 0
)
(print ssl)
(princ "已找到注释对象。")
;; Main loop
(setq opt T)
(while (and opt (> ssl 0))
(setq unctr (1+ unctr))
(command "_.UNDO" "_GROUP")
(initget "Location Justification Style Height Rotation Width Text Undo")
(setq opt (getkword
"\n高度(H)/调整(J)/位置(L)/旋转(R)/样式(S)/文字(T)/放弃(U)/宽度(W): "))
(if opt
(cond
((= opt "Undo")
(cht_Undo)
)
((= opt "Location")
(cht_Location)
)
((= opt "Justification")
(cht_Justification)
)
((= opt "Style")
(cht_Property "Style" "新样式名" 7) )
((= opt "Height")
(cht_Property "Height" "新高度" 40) )
((= opt "Rotation")
(cht_Property "Rotation" "新旋转角度" 50) )
((= opt "Width")
(cht_Property "Width" "新宽度因子" 41) )
((= opt "Text")
(cht_Text)
)
)
(setq opt nil)
)
(command "_.UNDO" "_END")
)
;; Restore
(if cht_OrgError (setq *error* cht_OrgError))
(eval (read U:E))
(ai_undo_off) ;; restore undo state
(if cht_OrgTexteval (setvar "texteval" cht_OrgTexteval))
(if cht_OrgHighlight (setvar "highlight" cht_OrgHighlight))
(if cht_OrgCmdecho (setvar "cmdecho" cht_OrgCmdecho))
(princ)
)
;;; Undo an entry
(defun cht_Undo ()
(if (> unctr 1)
(progn
(command "_.UNDO" "_END")
(command "_.UNDO" "2")
(setq unctr (- unctr 2))
)
(progn
(princ "\n无可放弃的操作。")
(setq unctr (- unctr 1))
)
)
)
;;; Change the location of an entry
(defun cht_Location ()
(setq sslen (sslength sset)
style ""
hgt ""
rot ""
txt ""
)
(command "_.CHANGE" sset "" "")
(while (> sslen 0)
(setq ent (entget(ssname sset (setq sslen (1- sslen))))
opt (list (cadr (assoc 11 ent))
(caddr (assoc 11 ent))
(cadddr (assoc 11 ent)))
)
(prompt "\n新文字位置: ")
(command pause)
(if (null loc)
(setq loc opt)
)
(command style hgt rot txt)
)
(command)
)
;;; Change the justification of an entry
(defun cht_Justification ()
(initget "TL TC TR ML MC MR BL BC BR Align Center Fit Left Middle Right ?")
(setq sslen (sslength sset))
(setq justp (getkword "\n对齐(A)/拟合(F)/中心(C)/向左(L)/中央(M)/向右(R)/左上(TL)/中上(TC)/右上(TR)/左中(ML)/正中(MC)/右中(MR)/左下(BL)/中下(BC)/右下(BR)/<?>: "))
(cond
((= justp "Left") (setq justp 0 justq 0 just-idx 4) )
((= justp "Center") (setq justp 1 justq 0 just-idx 5) )
((= justp "Right") (setq justp 2 justq 0 just-idx 6) )
((= justp "Align") (setq justp 3 justq 0 just-idx 1) )
((= justp "Fit") (setq justp 5 justq 0 just-idx 1) )
((= justp "TL") (setq justp 0 justq 3 just-idx 1) )
((= justp "TC") (setq justp 1 justq 3 just-idx 2) )
((= justp "TR") (setq justp 2 justq 3 just-idx 3) )
((= justp "ML") (setq justp 0 justq 2 just-idx 4) )
((= justp "Middle") (setq justp 4 justq 0 just-idx 5) )
((= justp "MC") (setq justp 1 justq 2 just-idx 5) )
((= justp "MR") (setq justp 2 justq 2 just-idx 6) )
((= justp "BL") (setq justp 0 justq 1 just-idx 7) )
((= justp "BC") (setq justp 1 justq 1 just-idx 8) )
((= justp "BR") (setq justp 2 justq 1 just-idx 9) )
((= justp "?") (setq justp nil) )
(T (setq justp nil) )
)
(if justp
(progn ;; Process them...
(while (> sslen 0)
(setq ent (entget (ssname sset (setq sslen (1- sslen)))))
(cond
((= (cdr (assoc 0 ent)) "MTEXT")
(setq ent (subst (cons 71 just-idx) (assoc 71 ent) ent))
)
((= (cdr (assoc 0 ent)) "TEXT")
(setq ent (subst (cons 72 justp) (assoc 72 ent) ent)
opt (trans (list (cadr (assoc 11 ent))
(caddr (assoc 11 ent))
(cadddr (assoc 11 ent)))
(cdr (assoc -1 ent)) ;; from ECS
1) ;; to current UCS
)
(setq ent (subst (cons 73 justq) (assoc 73 ent) ent))
(cond
((or (= justp 3) (= justp 5))
(prompt "\n新文字对齐点: ")
(if (= (setq orthom (getvar "orthomode")) 1)
(setvar "orthomode" 0)
)
(redraw (cdr (assoc -1 ent)) 3)
(initget 1)
(setq loc (getpoint))
(initget 1)
(setq loc1 (getpoint loc))
(redraw (cdr (assoc -1 ent)) 1)
(setvar "orthomode" orthom)
(setq ent (subst (cons 10 loc) (assoc 10 ent) ent))
(setq ent (subst (cons 11 loc1) (assoc 11 ent) ent))
)
((or (/= justp 0) (/= justq 0))
(redraw (cdr (assoc -1 ent)) 3)
(prompt "\n新文字位置: ")
(if (= (setq orthom (getvar "orthomode")) 1)
(setvar "orthomode" 0)
)
(setq loc (getpoint opt))
(setvar "orthomode" orthom)
(redraw (cdr (assoc -1 ent)) 1)
(if (null loc)
(setq loc opt)
(setq loc (trans loc 1 (cdr (assoc -1 ent))))
)
(setq ent (subst (cons 11 loc) (assoc 11 ent) ent))
)
)
)
)
(entmod ent)
)
)
(progn ;; otherwise list options
(textpage)
(princ "\n对齐方式选项: \n")
(princ "\t 左上中上右上\n")
(princ "\t 左中正中右中\n")
(princ "\t 左下中下右下\n")
(princ "\t 左中心右\n")
(princ "\t对齐中央调整\n")
(princ "\n按 ENTER 键继续: ")
(grread)
(princ "\r ")
(graphscr)
)
)
(command)
)
;;; Change the text of an object
(defun cht_Text ( / ans)
(setq sslen (sslength sset))
(initget "Globally Individually Retype")
(setq ans (getkword
"\n查找并替换文字。单个(I)/重新键入(R)/<全局(G)>: "))
(setq cht_OrgTexteval (getvar "texteval"))
(setvar "texteval" 1)
(cond
((= ans "Individually")
(progn
(initget "Yes No")
(setq ans (getkword "\n在对话框中编辑文字？<是(Y)>: "))
)
(while (> sslen 0)
(redraw (setq sn (ssname sset (setq sslen (1- sslen)))) 3)
(setq ss (ssadd))
(ssadd (ssname sset sslen) ss)
(if (= ans "No")
(cht_Edit ss)
(command "_.DDEDIT" sn "")
)
(redraw sn 1)
)
)
((= ans "Retype")
(while (> sslen 0)
(setq ent (entget (ssname sset (setq sslen (1- sslen)))))
(redraw (cdr (assoc -1 ent)) 3)
(prompt (strcat "\n原文字: " (cdr (assoc 1 ent))))
(setq nt (getstring T "\n新文字: "))
(redraw (cdr (assoc -1 ent)) 1)
(if (> (strlen nt) 0)
(entmod (subst (cons 1 nt) (assoc 1 ent) ent))
)
)
)
(T
(cht_Edit sset) ;; Change all
)
)
(setvar "texteval" cht_OrgTexteval)
)
;;; The old CHGTEXT command - rudimentary text editor
(defun C:CHGTEXT () (cht_Edit nil))
(defun cht_Edit (objs / last_o tot_o ent o_str n_str st s_temp
n_slen o_slen si chf chm cont ans class)
;; Select objects if running standalone
(if (null objs)
(setq objs (ssget))
)
(setq chm 0)
(if objs
(progn ;; If any objects selected
(if (= (type objs) 'ENAME)
(progn
(setq ent (entget objs))
(princ (strcat "\n现有字符串: " (cdr (assoc 1 ent))))
)
(if (= (sslength objs) 1)
(progn
(setq ent (entget (ssname objs 0)))
(princ (strcat "\n现有字符串: " (cdr (assoc 1 ent))))
)
)
)
(setq o_str (getstring "\n匹配字符串: " t))
(setq o_slen (strlen o_str))
(if (/= o_slen 0)
(progn
(setq n_str (getstring "\n新字符串: " t))
(setq n_slen (strlen n_str))
(setq last_o 0
tot_o (if (= (type objs) 'ENAME)
1
(sslength objs)
)
)
;; For each selected object...
(while (< last_o tot_o)
(setq class (cdr (assoc 0 (setq ent (entget (ssname objs last_o))))))
(if (or (= "TEXT" class)
(= "MTEXT" class) )
(progn
(setq chf nil si 1)
(setq s_temp (cdr (assoc 1 ent)))
(while (= o_slen (strlen (setq st (substr s_temp si o_slen))))
(if (= st o_str)
(progn
(setq s_temp (strcat
(if (> si 1)
(substr s_temp 1 (1- si))
""
)
n_str
(substr s_temp (+ si o_slen))
)
)
(setq chf t) ;; Found old string
(setq si (+ si n_slen))
)
(setq si (1+ si))
)
)
(if chf
(progn ;; Substitute new string for old
;; Modify the TEXT entity
(entmod (subst (cons 1 s_temp) (assoc 1 ent) ent))
(setq chm (1+ chm))
)
)
)
)
(setq last_o (1+ last_o))
)
)
;; else go on to the next line...
)
)
)
(if (/= (type objs) 'ENAME)
;; Print total lines changed
(if (/= (sslength objs) 1)
(princ (strcat (rtos chm 2 0) " 文字行已修改。"))
)
)
(terpri)
)
;;; Main procedure for manipulating text entities
(defun cht_Property (typ prmpt fld / temp ow nw ent tw sty w hw lw
sslen n sn ssl)
(if (= (sslength sset) 1) ;; Special case if there is only
;; one entity selected
;; Process one entity.
(cht_ProcessOne)
;; Else
(progn
;; Set prompt string.
(cht_SetPrompt)
(if (= nw "List")
;; Process List request.
(cht_ProcessList)
(if (= nw "Individual")
;; Process Individual request.
(cht_ProcessIndividual)
(if (= nw "Select")
;; Process Select request.
(cht_ProcessSelect)
;; Else
(progn
(if (= typ "Rotation")
(setq nw (* (/ nw 180.0) pi))
)
(if (= (type nw) 'STR)
(if (not (tblsearch "style" nw))
(progn
(princ (strcat nw ": 未找到样式。"))
)
(cht_ProcessAll)
)
(cht_ProcessAll)
)
)
)
)
)
)
)
)
;;; Change all of the entities in the selection set
(defun cht_ProcessAll (/ hl temp)
(setq sslen (sslength sset))
(setq hl (getvar "highlight"))
(setvar "highlight" 0)
(while (> sslen 0)
(setq temp (ssname sset (setq sslen (1- sslen))))
(entmod (subst (cons fld nw)
(assoc fld (setq ent (entget temp)))
ent ) )
)
(setvar "highlight" hl)
)
;;; Change one text entity
(defun cht_ProcessOne ()
(setq temp (ssname sset 0))
(setq ow (cdr (assoc fld (entget temp))))
(if (= opt "Rotation")
(setq ow (/ (* ow 180.0) pi))
)
(redraw (cdr (assoc -1 (entget temp))) 3)
(initget 0)
(if (= opt "Style")
(setq nw (getstring (strcat prmpt " <" ow ">: ")))
(setq nw (getreal (strcat prmpt " <" (rtos ow 2) ">: ")))
)
(if (or (= nw "") (= nw nil))
(setq nw ow)
)
(redraw (cdr (assoc -1 (entget temp))) 1)
(if (= opt "Rotation")
(setq nw (* (/ nw 180.0) pi))
)
(if (= opt "Style")
(if (null (tblsearch "style" nw))
(princ (strcat nw ": 未找到样式。"))
(entmod (subst (cons fld nw)
(assoc fld (setq ent (entget temp)))
ent
)
)
)
(entmod (subst (cons fld nw)
(assoc fld (setq ent (entget temp)))
ent
)
)
)
)
;;; Set the prompt string
(defun cht_SetPrompt ()
(if (= typ "Style")
(progn
(initget "Individual List New Select ")
(setq nw (getkword (strcat "\n单个(I)/列表(L)/选择样式(S)/<"
prmpt
" 为所有文字对象" ">: ")))
(if (or (= nw "") (= nw nil) (= nw "输入"))
(setq nw (getstring (strcat prmpt
" 为所有文字对象" ": ")))
)
)
(progn
(initget "List Individual" 1)
(setq nw (getreal (strcat "\n单个(I)/列表(L)/<"
prmpt
" 为所有文字对象" ">: ")))
)
)
)
;;; Process List request
(defun cht_ProcessList ()
(setq unctr (1- unctr))
(setq sslen (sslength sset))
(setq tw 0)
(while (> sslen 0)
(setq temp (ssname sset (setq sslen (1- sslen))))
(if (= typ "Style")
(progn
(if (= tw 0)
(setq tw (list (cdr (assoc fld (entget temp)))))
(progn
(setq sty (cdr (assoc fld (entget temp))))
(if (not (member sty tw))
(setq tw (append tw (list sty)))
)
)
)
)
(progn
(setq tw (+ tw (setq w (cdr (assoc fld (entget temp))))))
(if (= (sslength sset) (1+ sslen)) (setq lw w hw w))
(if (< hw w) (setq hw w))
(if (> lw w) (setq lw w))
)
)
)
(if (= typ "Rotation")
(setq tw (* (/ tw pi) 180.0)
lw (* (/ lw pi) 180.0)
hw (* (/ hw pi) 180.0))
)
(if (= typ "Style")
(progn
(princ (strcat "\n" typ " -- "))
(princ tw)
)
(princ (strcat "\n" typ
" -- 最小: " (rtos lw 2)
"\t 最大: " (rtos hw 2)
"\t 平均: " (rtos (/ tw (sslength sset)) 2) ) )
)
)
;;; Process Individual request
(defun cht_ProcessIndividual ()
(setq sslen (sslength sset))
(while (> sslen 0)
(setq temp (ssname sset (setq sslen (1- sslen))))
(setq ow (cdr (assoc fld (entget temp))))
(if (= typ "Rotation")
(setq ow (/ (* ow 180.0) pi))
)
(initget 0)
(redraw (cdr (assoc -1 (entget temp))) 3)
(if (= typ "Style")
(progn
(setq nw (getstring (strcat "\n" prmpt " <" ow ">: ")))
)
(progn
(setq nw (getreal (strcat "\n" prmpt " <" (rtos ow 2) ">: ")))
)
)
(if (or (= nw "") (= nw nil))
(setq nw ow)
)
(if (= typ "Rotation")
(setq nw (* (/ nw 180.0) pi))
)
(entmod (subst (cons fld nw)
(assoc fld (setq ent (entget temp)))
ent
)
)
(redraw (cdr (assoc -1 (entget temp))) 1)
)
)
;;; Process the Select option
(defun cht_ProcessSelect ()
(princ "\n给出搜索样式名？<*>: ")
(setq sn (xstrcase (getstring))
n -1
nsset (ssadd)
ssl (1- (sslength sset))
)
(if (or (= sn "*") (null sn) (= sn ""))
(setq nsset sset sn "*")
(while (and sn (< n ssl))
(setq temp (ssname sset (setq n (1+ n))))
(if (= (cdr (assoc 7 (entget temp))) sn)
(ssadd temp nsset)
)
)
)
(princ (strcat "\n样式: " sn))
(print (setq ssl (sslength nsset)))
(princ " 个对象已找到。")
)
;;; Check to see if AI_UTILS is loaded, If not, try to find it,
;;; and then try to load it. If it can't be found or can't be
;;; loaded, then abort the loading of this file immediately.
(cond
((and ai_dcl (listp ai_dcl))) ; it's already loaded.
((not (findfile "ai_utils.lsp")) ; find it
(ai_abort "CHT" nil)
)
((eq "failed" (load "ai_utils" "failed")) ; load it
(ai_abort "CHT" nil)
)
)
;;; If we get this far, then AI_UTILS.LSP is loaded and it can
;;; be assumed that all functions defined therein are available.
;;; Next, check to see if ACADAPP.EXP has been xloaded, and abort
;;; if the file can't be found or xloaded. Note that AI_ACADAPP
;;; does not abort the running application itself (so that it can
;;; also be called from within the command without also stopping
;;; an AutoCAD command currently in progress).
(if (not (ai_acadapp)) (ai_abort "CHT" nil))
;;; The C: function definition
(defun c:cht () (cht_Main))
(princ "\n\t已加载 CHT 命令。")
(princ)

; Next available MSG number is   83 
; MODULE_ID CHTEXT_LSP_ 
; $Header: /sedona/develop/support/chtext.lsp 8     4/29/97 5:35p Derrl $ 
;;; 
;;;    CHTEXT.lsp - change text 
;;; 
;;;    Copyright 1997 by Autodesk, Inc. 
;;; 
;;;    Permission to use, copy, modify, and distribute this software 
;;;    for any purpose and without fee is hereby granted, provided 
;;;    that the above copyright notice appears in all copies and 
;;;    that both that copyright notice and the limited warranty and 
;;;    restricted rights notice below appear in all supporting 
;;;    documentation. 
;;; 
;;;    AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS. 
;;;    AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF 
;;;    MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE.  AUTODESK, INC. 
;;;    DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE 
;;;    UNINTERRUPTED OR ERROR FREE. 
;;; 
;;;    Use, duplication, or disclosure by the U.S. Government is subject to 
;;;    restrictions set forth in FAR 52.227-19 (Commercial Computer 
;;;    Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii) 
;;;    (Rights in Technical Data and Computer Software), as applicable. 
;;;   
;;;--------------------------------------------------------------------------; 
;;; DESCRIPTION 
;;;   This is a "text processor" which operates in a global manner 
;;;   on all of the text entities that the user selects; i.e., the 
;;;   Height, Justification, Location, Rotation, Style, Text, and 
;;;   Width can all be changed globally or individually, and the 
;;;   range of values for a given parameter can be listed. 
;;;    
;;;   The command is called with CHT from the command line at which 
;;;   time the user is asked to select the objects to change. 
;;;    
;;;     Select text to change. 
;;;     Select objects: 
;;;   
;;;   If nothing is selected the message "ERROR: Nothing selected." 
;;;   is displayed and the command is terminated.  If more than 25 
;;;   entities are selected the following message is displayed while 
;;;   the text entities are sorted out from the non-text entities. 
;;;   A count of the text entities found is then displayed. 
;;;    
;;;     Verifying the selected entities... 
;;;     nnn  text entities found. 
;;;     CHText:  Height/Justification/Location/Rotation/Style/Text/Undo/Width: 
;;;    
;;;   A typical example of the prompts you may encounter follows: 
;;;    
;;;   If you select a single text entity to change and ask to change 
;;;   the height, the prompt looks like this: 
;;;    
;;;     CHText:  Height/Justification/Location/Rotation/Style/Text/Undo/Width: 
;;;     New text height for text entity. <0.08750000>: 
;;;    
;;;   If you select more than one text entity to change and ask to change 
;;;   the height, the prompt looks like this: 
;;;    
;;;     CHText:  Height/Justification/Location/Rotation/Style/Text/Undo/Width: 
;;;     Individual/List/<New height for all entities>: 
;;;    
;;;   Typing "L" at this prompt returns a prompt showing you the range of 
;;;   values that you are using for your text. 
;;;    
;;;     Height -- Min: 0.05000000  Max: 0.10000000  Ave: 0.08392857 
;;;    
;;;   Typing "I" at this prompt puts you in a loop, processing the text 
;;;   entities you have selected one at a time, and giving the same prompt 
;;;   you get for a single text entity shown above. 
;;;    
;;;   Pressing ENTER at this point puts you back at the Command: prompt. 
;;;   Selecting any of the other options allows you to change the text 
;;;   entities selected. 
;;;    
;;;---------------------------------------------------------------------------; 
 
(defun cht_Main ( / sset opt ssl nsset temp unctr ct_ver sslen style hgt rot 
                    txt ent loc loc1 just-idx justp justq orthom 
                    cht_ErrorHandler cht_OrgError cht_OrgCmdecho 
                    cht_OrgTexteval cht_OrgHighlight) 
 
  ;; Reset if changed 
  (setq ct_ver "2.00") 
 
  ;; Internal error handler defined locally 
  (defun cht_ErrorHandler (s) 
    (if (/= s "函数已取消") 
      (if (= s "quit / exit abort") 
        (princ) 
        (princ (strcat "\n错误: " s)) 
      ) 
    ) 
    (eval (read U:E)) 
    ;;  Reset original error handler if there 
    (if cht_OrgError (setq *error* cht_OrgError)) 
    (if temp (redraw temp 1)) 
    (ai_undo_off) ;; restore undo state 
    (if cht_OrgCmdecho (setvar "cmdecho" cht_OrgCmdecho)) 
    (if cht_OrgTexteval (setvar "texteval" cht_OrgTexteval)) 
    (if cht_OrgHighlight (setvar "highlight" cht_OrgHighlight)) 
    (princ) 
  ) 
 
  ;; Set error handler 
  (if *error* 
    (setq cht_OrgError *error* 
          *error* cht_ErrorHandler) 
    (setq *error* cht_ErrorHandler) 
  ) 
 
  ;; Set undo groups and ends with (eval(read U:G)) or (eval(read U:E)) 
  (setq U:G "(command "_.undo" "_group")" 
        U:E "(command "_.undo" "_en")" 
  ) 
   
  (ai_undo_on)       ;; enable undo 
   
  (setq cht_OrgCmdecho (getvar "cmdecho")) 
  (setq cht_OrgHighlight (getvar "highlight")) 
  (setvar "cmdecho" 0) 
   
  (princ (strcat "\n修改文字，Version " 
                 ct_ver 
                 ", 版权(c) 1997 Autodesk, Inc.")) 
  (prompt "\n选择要修改的注释对象。") 
  (setq sset (ai_aselect)) 
  (if (null sset) 
    (progn 
      (princ "\n未选择对象。") 
      (exit) 
    ) 
  ) 
  ;; Validate selection set 
  (setq ssl   (sslength sset) 
        nsset (ssadd)) 
  (if (> ssl 25) 
    (princ "\n验证选择的对象...") 
  ) 
  (while (> ssl 0) 
    (setq temp (ssname sset (setq ssl (1- ssl)))) 
    (if (or 
          (= (cdr (assoc 0 (entget temp))) "TEXT") 
          (= (cdr (assoc 0 (entget temp))) "ATTDEF") 
          (= (cdr (assoc 0 (entget temp))) "MTEXT") 
        ) 
      (ssadd temp nsset) 
    ) 
  ) 
  (setq ssl (sslength nsset) 
        sset nsset 
        unctr 0 
  ) 
  (print ssl) 
  (princ "已找到注释对象。") 
 
  ;; Main loop 
  (setq opt T) 
  (while (and opt (> ssl 0)) 
    (setq unctr (1+ unctr)) 
    (command "_.UNDO" "_GROUP") 
    (initget "Location Justification Style Height Rotation Width Text Undo") 
    (setq opt (getkword 
      "\n高度(H)/调整(J)/位置(L)/旋转(R)/样式(S)/文字(T)/放弃(U)/宽度(W): ")) 
    (if opt 
      (cond 
        ((= opt "Undo") 
          (cht_Undo) 
        ) 
        ((= opt "Location") 
          (cht_Location) 
        ) 
        ((= opt "Justification") 
          (cht_Justification) 
        ) 
        ((= opt "Style") 
          (cht_Property "Style"    "新样式名"      7) ) 
        ((= opt "Height") 
          (cht_Property "Height"   "新高度"         40) ) 
        ((= opt "Rotation") 
          (cht_Property "Rotation" "新旋转角度" 50) ) 
        ((= opt "Width") 
          (cht_Property "Width"    "新宽度因子"   41) ) 
        ((= opt "Text") 
          (cht_Text) 
        ) 
      ) 
      (setq opt nil) 
    ) 
    (command "_.UNDO" "_END") 
  ) 
 
  ;; Restore 
  (if cht_OrgError (setq *error* cht_OrgError)) 
  (eval (read U:E)) 
  (ai_undo_off) ;; restore undo state 
  (if cht_OrgTexteval (setvar "texteval" cht_OrgTexteval)) 
  (if cht_OrgHighlight (setvar "highlight" cht_OrgHighlight)) 
  (if cht_OrgCmdecho (setvar "cmdecho" cht_OrgCmdecho)) 
  (princ) 
) 
 
;;; Undo an entry 
(defun cht_Undo () 
  (if (> unctr 1) 
    (progn 
      (command "_.UNDO" "_END") 
      (command "_.UNDO" "2") 
      (setq unctr (- unctr 2)) 
    ) 
    (progn 
      (princ "\n无可放弃的操作。") 
      (setq unctr (- unctr 1)) 
    ) 
  ) 
) 
 
;;; Change the location of an entry 
(defun cht_Location () 
  (setq sslen (sslength sset) 
        style "" 
        hgt   "" 
        rot   "" 
        txt   "" 
  ) 
  (command "_.CHANGE" sset "" "") 
  (while (> sslen 0) 
    (setq ent (entget(ssname sset (setq sslen (1- sslen)))) 
          opt (list (cadr (assoc 11 ent)) 
                    (caddr (assoc 11 ent)) 
                    (cadddr (assoc 11 ent))) 
    ) 
    (prompt "\n新文字位置: ") 
    (command pause) 
    (if (null loc) 
      (setq loc opt) 
    ) 
    (command style hgt rot txt) 
  ) 
  (command) 
) 
 
;;; Change the justification of an entry 
(defun cht_Justification () 
  (initget "TL TC TR ML MC MR BL BC BR Align Center Fit Left Middle Right ?") 
  (setq sslen (sslength sset)) 
  (setq justp (getkword "\n对齐(A)/拟合(F)/中心(C)/向左(L)/中央(M)/向右(R)/左上(TL)/中上(TC)/右上(TR)/左中(ML)/正中(MC)/右中(MR)/左下(BL)/中下(BC)/右下(BR)/<?>: ")) 
  (cond 
    ((= justp "Left")    (setq justp 0 justq 0 just-idx 4) ) 
    ((= justp "Center")  (setq justp 1 justq 0 just-idx 5) ) 
    ((= justp "Right")   (setq justp 2 justq 0 just-idx 6) ) 
    ((= justp "Align")   (setq justp 3 justq 0 just-idx 1) ) 
    ((= justp "Fit")     (setq justp 5 justq 0 just-idx 1) ) 
    ((= justp "TL")      (setq justp 0 justq 3 just-idx 1) ) 
    ((= justp "TC")      (setq justp 1 justq 3 just-idx 2) ) 
    ((= justp "TR")      (setq justp 2 justq 3 just-idx 3) ) 
    ((= justp "ML")      (setq justp 0 justq 2 just-idx 4) ) 
    ((= justp "Middle")  (setq justp 4 justq 0 just-idx 5) ) 
    ((= justp "MC")      (setq justp 1 justq 2 just-idx 5) ) 
    ((= justp "MR")      (setq justp 2 justq 2 just-idx 6) ) 
    ((= justp "BL")      (setq justp 0 justq 1 just-idx 7) ) 
    ((= justp "BC")      (setq justp 1 justq 1 just-idx 8) ) 
    ((= justp "BR")      (setq justp 2 justq 1 just-idx 9) ) 
    ((= justp "?")       (setq justp nil)       ) 
    (T                   (setq justp nil)       ) 
  )    
  (if justp 
    (progn ;; Process them... 
      (while (> sslen 0) 
        (setq ent (entget (ssname sset (setq sslen (1- sslen))))) 
        (cond 
          ((= (cdr (assoc 0 ent)) "MTEXT") 
            (setq ent (subst (cons 71 just-idx) (assoc 71 ent) ent)) 
          ) 
          ((= (cdr (assoc 0 ent)) "TEXT") 
            (setq ent (subst (cons 72 justp) (assoc 72 ent) ent) 
                  opt (trans (list (cadr (assoc 11 ent)) 
                                   (caddr (assoc 11 ent)) 
                                   (cadddr (assoc 11 ent))) 
                             (cdr (assoc -1 ent)) ;; from ECS 
                             1)               ;; to current UCS 
            ) 
            (setq ent (subst (cons 73 justq) (assoc 73 ent) ent)) 
            (cond 
              ((or (= justp 3) (= justp 5)) 
                (prompt "\n新文字对齐点: ") 
                (if (= (setq orthom (getvar "orthomode")) 1) 
                  (setvar "orthomode" 0) 
                ) 
                (redraw (cdr (assoc -1 ent)) 3) 
                (initget 1) 
                (setq loc (getpoint)) 
                (initget 1) 
                (setq loc1 (getpoint loc)) 
                (redraw (cdr (assoc -1 ent)) 1) 
                (setvar "orthomode" orthom) 
                (setq ent (subst (cons 10 loc) (assoc 10 ent) ent)) 
                (setq ent (subst (cons 11 loc1) (assoc 11 ent) ent)) 
              ) 
              ((or (/= justp 0) (/= justq 0)) 
                (redraw (cdr (assoc -1 ent)) 3) 
                (prompt "\n新文字位置: ") 
                (if (= (setq orthom (getvar "orthomode")) 1) 
                  (setvar "orthomode" 0) 
                ) 
                (setq loc (getpoint opt)) 
                (setvar "orthomode" orthom) 
                (redraw (cdr (assoc -1 ent)) 1) 
                (if (null loc) 
                  (setq loc opt) 
                  (setq loc (trans loc 1 (cdr (assoc -1 ent)))) 
                ) 
                (setq ent (subst (cons 11 loc) (assoc 11 ent) ent)) 
              ) 
            ) 
          ) 
        ) 
        (entmod ent) 
      ) 
    ) 
    (progn        ;; otherwise list options 
      (textpage) 
      (princ "\n对齐方式选项: \n") 
      (princ "\t  左上   中上    右上\n") 
      (princ "\t  左中   正中    右中\n") 
      (princ "\t  左下   中下    右下\n") 
      (princ "\t 左     中心    右\n") 
      (princ "\t对齐    中央    调整\n") 
      (princ "\n按 ENTER 键继续: ") 
      (grread) 
      (princ "\r                                                            ") 
      (graphscr) 
    ) 
  ) 
  (command) 
) 
 
;;; Change the text of an object 
(defun cht_Text ( / ans) 
  (setq sslen (sslength sset)) 
  (initget "Globally Individually Retype") 
  (setq ans (getkword 
    "\n查找并替换文字。  单个(I)/重新键入(R)/<全局(G)>: ")) 
  (setq cht_OrgTexteval (getvar "texteval")) 
  (setvar "texteval" 1) 
  (cond 
    ((= ans "Individually") 
      (progn 
        (initget "Yes No") 
        (setq ans (getkword "\n在对话框中编辑文字？<是(Y)>: ")) 
      ) 
   
      (while (> sslen 0) 
        (redraw (setq sn (ssname sset (setq sslen (1- sslen)))) 3) 
        (setq ss (ssadd)) 
        (ssadd (ssname sset sslen) ss) 
        (if (= ans "No") 
          (cht_Edit ss) 
          (command "_.DDEDIT" sn "") 
        ) 
        (redraw sn 1) 
      ) 
    ) 
    ((= ans "Retype") 
      (while (> sslen 0) 
        (setq ent (entget (ssname sset (setq sslen (1- sslen))))) 
        (redraw (cdr (assoc -1 ent)) 3) 
        (prompt (strcat "\n原文字: " (cdr (assoc 1 ent)))) 
        (setq nt (getstring  T "\n新文字: ")) 
        (redraw (cdr (assoc -1 ent)) 1) 
        (if (> (strlen nt) 0) 
          (entmod (subst (cons 1 nt) (assoc 1 ent) ent)) 
        ) 
      ) 
    ) 
    (T 
      (cht_Edit sset)   ;; Change all 
    ) 
  ) 
  (setvar "texteval" cht_OrgTexteval) 
) 
 
;;; The old CHGTEXT command - rudimentary text editor 
(defun C:CHGTEXT () (cht_Edit nil)) 
 
(defun cht_Edit (objs / last_o tot_o ent o_str n_str st s_temp 
                       n_slen o_slen si chf chm cont ans class) 
  ;; Select objects if running standalone 
  (if (null objs) 
    (setq objs (ssget)) 
  ) 
  (setq chm 0) 
  (if objs 
    (progn                   ;; If any objects selected 
      (if (= (type objs) 'ENAME) 
        (progn 
          (setq ent (entget objs)) 
          (princ (strcat "\n现有字符串: " (cdr (assoc 1 ent)))) 
        ) 
        (if (= (sslength objs) 1) 
          (progn 
            (setq ent (entget (ssname objs 0))) 
            (princ (strcat "\n现有字符串: " (cdr (assoc 1 ent)))) 
          ) 
        ) 
      ) 
      (setq o_str (getstring "\n匹配字符串: " t)) 
      (setq o_slen (strlen o_str)) 
      (if (/= o_slen 0) 
        (progn 
          (setq n_str (getstring "\n新字符串: " t)) 
          (setq n_slen (strlen n_str)) 
          (setq last_o 0 
                tot_o  (if (= (type objs) 'ENAME) 
                         1 
                         (sslength objs) 
                       ) 
          ) 
          ;; For each selected object... 
          (while (< last_o tot_o) 
            (setq class (cdr (assoc 0 (setq ent (entget (ssname objs last_o)))))) 
            (if (or (= "TEXT" class) 
                    (= "MTEXT" class) ) 
              (progn 
                (setq chf nil si 1) 
                (setq s_temp (cdr (assoc 1 ent))) 
                (while (= o_slen (strlen (setq st (substr s_temp si o_slen)))) 
                  (if (= st o_str) 
                    (progn 
                      (setq s_temp (strcat 
                                     (if (> si 1) 
                                       (substr s_temp 1 (1- si)) 
                                       "" 
                                     ) 
                                     n_str 
                                     (substr s_temp (+ si o_slen)) 
                                   ) 
                      ) 
                      (setq chf t)    ;; Found old string 
                      (setq si (+ si n_slen)) 
                    ) 
                    (setq si (1+ si)) 
                  ) 
                ) 
                (if chf 
                  (progn              ;; Substitute new string for old 
                    ;; Modify the TEXT entity 
                    (entmod (subst (cons 1 s_temp) (assoc 1 ent) ent)) 
                    (setq chm (1+ chm)) 
                  ) 
                ) 
              ) 
            ) 
            (setq last_o (1+ last_o)) 
          ) 
        ) 
        ;; else go on to the next line... 
      ) 
    ) 
  ) 
  (if (/= (type objs) 'ENAME) 
    ;; Print total lines changed 
    (if (/= (sslength objs) 1) 
      (princ (strcat (rtos chm 2 0) " 文字行已修改。")) 
    ) 
  ) 
  (terpri) 
) 
 
;;; Main procedure for manipulating text entities 
(defun cht_Property (typ prmpt fld / temp ow nw ent tw sty w hw lw 
                              sslen n sn ssl) 
  (if (= (sslength sset) 1)           ;; Special case if there is only 
                                      ;; one entity selected 
    ;; Process one entity. 
    (cht_ProcessOne) 
    ;; Else 
    (progn 
      ;; Set prompt string. 
      (cht_SetPrompt) 
      (if (= nw "List") 
        ;; Process List request. 
        (cht_ProcessList) 
        (if (= nw "Individual") 
          ;; Process Individual request. 
          (cht_ProcessIndividual) 
          (if (= nw "Select") 
            ;; Process Select request. 
            (cht_ProcessSelect) 
            ;; Else 
            (progn 
              (if (= typ "Rotation") 
                (setq nw (* (/ nw 180.0) pi)) 
              ) 
              (if (= (type nw) 'STR) 
                (if (not (tblsearch "style" nw)) 
                  (progn 
                    (princ (strcat nw ": 未找到样式。")) 
                  ) 
                  (cht_ProcessAll) 
                ) 
                (cht_ProcessAll) 
              ) 
            ) 
          ) 
        ) 
      ) 
    ) 
  ) 
) 
 
;;; Change all of the entities in the selection set 
(defun cht_ProcessAll (/ hl temp) 
  (setq sslen (sslength sset)) 
  (setq hl (getvar "highlight")) 
  (setvar "highlight" 0) 
  (while (> sslen 0) 
    (setq temp (ssname sset (setq sslen (1- sslen)))) 
    (entmod (subst (cons fld nw) 
                   (assoc fld (setq ent (entget temp))) 
                   ent ) ) 
  ) 
  (setvar "highlight" hl) 
) 
 
;;; Change one text entity 
(defun cht_ProcessOne () 
  (setq temp (ssname sset 0)) 
  (setq ow (cdr (assoc fld (entget temp)))) 
  (if (= opt "Rotation") 
    (setq ow (/ (* ow 180.0) pi)) 
  ) 
  (redraw (cdr (assoc -1 (entget temp))) 3) 
  (initget 0) 
  (if (= opt "Style") 
    (setq nw (getstring (strcat prmpt " <" ow ">: "))) 
    (setq nw (getreal (strcat prmpt " <" (rtos ow 2) ">: "))) 
  ) 
  (if (or (= nw "") (= nw nil)) 
    (setq nw ow) 
  ) 
  (redraw (cdr (assoc -1 (entget temp))) 1) 
  (if (= opt "Rotation") 
    (setq nw (* (/ nw 180.0) pi)) 
  ) 
  (if (= opt "Style") 
    (if (null (tblsearch "style" nw)) 
      (princ (strcat nw ": 未找到样式。")) 
      (entmod (subst (cons fld nw) 
                     (assoc fld (setq ent (entget temp))) 
                     ent 
              ) 
      ) 
    ) 
    (entmod (subst (cons fld nw) 
                   (assoc fld (setq ent (entget temp))) 
                   ent 
            ) 
    ) 
  ) 
) 
 
;;; Set the prompt string 
(defun cht_SetPrompt () 
  (if (= typ "Style") 
    (progn 
      (initget "Individual List New Select ") 
      (setq nw (getkword (strcat "\n单个(I)/列表(L)/选择样式(S)/<" 
                                 prmpt 
                                 " 为所有文字对象" ">: "))) 
      (if (or (= nw "") (= nw nil) (= nw "输入")) 
        (setq nw (getstring (strcat prmpt 
                                    " 为所有文字对象" ": "))) 
      ) 
    ) 
    (progn 
      (initget "List Individual" 1) 
      (setq nw (getreal (strcat "\n单个(I)/列表(L)/<" 
                                 prmpt 
                                 " 为所有文字对象" ">: "))) 
    ) 
  ) 
) 
 
;;; Process List request 
(defun cht_ProcessList () 
  (setq unctr (1- unctr)) 
  (setq sslen (sslength sset)) 
  (setq tw 0) 
  (while (> sslen 0) 
    (setq temp (ssname sset (setq sslen (1- sslen)))) 
    (if (= typ "Style") 
      (progn 
        (if (= tw 0) 
          (setq tw (list (cdr (assoc fld (entget temp))))) 
          (progn 
            (setq sty (cdr (assoc fld (entget temp)))) 
            (if (not (member sty tw)) 
              (setq tw (append tw (list sty))) 
            ) 
          ) 
        ) 
      ) 
      (progn 
        (setq tw (+ tw (setq w (cdr (assoc fld (entget temp)))))) 
        (if (= (sslength sset) (1+ sslen)) (setq lw w hw w)) 
        (if (< hw w) (setq hw w)) 
        (if (> lw w) (setq lw w)) 
      ) 
    ) 
  ) 
  (if (= typ "Rotation") 
    (setq tw (* (/ tw pi) 180.0) 
          lw (* (/ lw pi) 180.0) 
          hw (* (/ hw pi) 180.0)) 
  ) 
  (if (= typ "Style") 
    (progn 
      (princ (strcat "\n" typ " -- ")) 
      (princ tw) 
    ) 
    (princ (strcat "\n" typ 
             " -- 最小: " (rtos lw 2) 
             "\t 最大: " (rtos hw 2) 
             "\t 平均: " (rtos (/ tw (sslength sset)) 2) ) ) 
  ) 
) 
 
;;; Process Individual request 
(defun cht_ProcessIndividual () 
  (setq sslen (sslength sset)) 
  (while (> sslen 0) 
    (setq temp (ssname sset (setq sslen (1- sslen)))) 
    (setq ow (cdr (assoc fld (entget temp)))) 
    (if (= typ "Rotation") 
      (setq ow (/ (* ow 180.0) pi)) 
    ) 
    (initget 0) 
    (redraw (cdr (assoc -1 (entget temp))) 3) 
    (if (= typ "Style") 
      (progn 
        (setq nw (getstring (strcat "\n" prmpt " <" ow ">: "))) 
      ) 
      (progn 
        (setq nw (getreal (strcat "\n" prmpt " <" (rtos ow 2) ">: "))) 
      ) 
    ) 
    (if (or (= nw "") (= nw nil)) 
      (setq nw ow) 
    ) 
    (if (= typ "Rotation") 
      (setq nw (* (/ nw 180.0) pi)) 
    ) 
    (entmod (subst (cons fld nw) 
                   (assoc fld (setq ent (entget temp))) 
                   ent 
            ) 
    ) 
    (redraw (cdr (assoc -1 (entget temp))) 1) 
  ) 
) 
 
;;; Process the Select option 
(defun cht_ProcessSelect () 
  (princ "\n给出搜索样式名？<*>: ") 
  (setq sn  (xstrcase (getstring)) 
        n   -1 
        nsset (ssadd) 
        ssl (1- (sslength sset)) 
        ) 
  (if (or (= sn "*") (null sn) (= sn "")) 
    (setq nsset sset sn "*") 
    (while (and sn (< n ssl)) 
      (setq temp (ssname sset (setq n (1+ n)))) 
      (if (= (cdr (assoc 7 (entget temp))) sn) 
        (ssadd temp nsset) 
      ) 
    ) 
  ) 
 
  (princ (strcat "\n样式: " sn)) 
  (print (setq ssl (sslength nsset))) 
  (princ " 个对象已找到。") 
) 
 
;;; Check to see if AI_UTILS is loaded, If not, try to find it, 
;;; and then try to load it.  If it can't be found or can't be 
;;; loaded, then abort the loading of this file immediately. 
(cond 
  ((and ai_dcl (listp ai_dcl)))                ; it's already loaded. 
  ((not (findfile "ai_utils.lsp"))                ; find it 
    (ai_abort "CHT" nil) 
  ) 
  ((eq "failed" (load "ai_utils" "failed"))        ; load it 
    (ai_abort "CHT" nil) 
  ) 
) 
 
;;; If we get this far, then AI_UTILS.LSP is loaded and it can 
;;; be assumed that all functions defined therein are available. 
 
;;; Next, check to see if ACADAPP.EXP has been xloaded, and abort 
;;; if the file can't be found or xloaded.  Note that AI_ACADAPP 
;;; does not abort the running application itself (so that it can 
;;; also be called from within the command without also stopping 
;;; an AutoCAD command currently in progress). 
(if (not (ai_acadapp)) (ai_abort "CHT" nil)) 
 
;;; The C: function definition 
(defun c:cht () (cht_Main)) 
(princ "\n\t已加载 CHT 命令。") 
(princ)

沙粒 · 发表于 2003-5-20 11:53:07

请各位先弄清问题的关键所在（我在把它复述一遍）：

如果感到原有DWG文件中的字体宽高比不合适，而文件中的字体又各自具有不同的文字高度和转角需要保持，怎样能更有效地仅仅改变这些文字的宽度比例？比如将宽度比例全部由1.0改为0.7。

改变单串文字的宽度比例，CAD应用者可能都掌握。
关键是想修改一个已经做好的DWG文件中的许许多多各自具有不同高度和转角的文字的宽度比例。
在文字样式中修改不会对图中原有文字宽度比例起作用。
而用属性匹配，又会改变各文字分别具有的高度和转角属性。

另外，当过滤出同一种属性的许多文字时，是可以改变其宽高比属性的，单当过滤出的文字具有不同属性时，更改特性的命令对话框中就没有宽度比例这一项了，也就是说不能再用这一方法调整其宽高比属性了。

请各位真正大师级用户发表高见！

真诚希望XLLI8704兄和zhynt斑竹详细说明一下你们的做法。

yxc · 发表于 2003-5-20 16:17:03

我不是大师，只能提供一点参考

如果文字全为单行文字[/COLOR] ，ahlzl的方法是可以的。XLLI8704说的就是这个方法，zhynt斑竹说的CHT的功能也可以在这个“特性”窗口中实现。

如果包含多行文字[/COLOR] ，此法不通，多行文字只能修改样式（注：单行文字修改样式宽度比例，对已生成的文字的宽度比例无效，多行文字可以的）。

如果能将多行文字进行分解，也变成了单行文字……

演示中除了最下面一行为多行文字，其余均为单行文字

yxc · 发表于 2003-5-20 16:28:38

修改样式……

lkai_11 · 发表于 2003-5-20 22:10:20

这个问题需要大师级的来解决吗？
提供解决方案的都是大师级的呀！
并且我认为他们解答的很好！：）

账号		自动登录	找回密码
密码			立即注册

[讨论]：如何更改多种高度和角度原有文字的宽度比例

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子