[编程申请]：能编一个命令，将选中的所有不同文字变成同样的字

快乐街

这是从别人哪拿来的东西，可以一次将选中的文字变成同样的字（如将选中的字都变成“/”）工具箱中可以增加这个功能吗，这样我就不用每次要用时去加载文件。

2. 
   
3. [CODE]
   
4.   [FONT=courier new]
   
5. (defun c:tt(/ ss newtext i)
   
6.   (princ "\n旧文字:")
   
7.   (setq ss (ssget '((0 . "TEXT"))))
   
8.   (princ "\n新文字:")
   
9.   (setq newtext (getstring))
   
10.   (setq i 0)
    
11.   (repeat (sslength ss)
    
12.     (entmod (subst (cons 1 newtext) (assoc 1 (setq elist (entget (ssname ss i)))) elist))
    
13.     (setq i (1+ i))
    
14.   )
    
15.   (princ)
    
16. )
    
17. (defun c:ts(/ ss size i)
    
18.   (prompt "\n选取需改变高度的文字:")
    
19.   (setq ss (ssget '((0 . "TEXT"))))
    
20.   (princ "文字高度<") (princ (cdr(assoc 40 (entget (ssname ss 0))))) (princ ">:")
    
21.   (setq size (getdist))
    
22.   (if (not size) (setq size (cdr(assoc 40 (entget (ssname ss 0))))))
    
23.   (setq i 0)
    
24.   (repeat (sslength ss)
    
25.     (entmod (subst (cons 40 size) (assoc 40 (setq elist (entget (ssname ss i)))) elist))
    
26.     (setq i (+ 1 i))
    
27.   )
    
28.   (princ)
    
29. )
    
30. 
    
31. (defun c:sj(/ os pt1 pt2 ang12)
    
32.   (setq os (getvar "osmode"))
    
33.   (setvar "plinewid" 45)
    
34.   (setvar "osmode" 0)
    
35.   (setq pt1 (getpoint "\n第一点:"))
    
36.   (setq pt2 (getpoint pt1 "\n第二点:"))
    
37.   (setq ang12 (angle pt1 pt2) wid 45)
    
38.   (command "pline" (polar pt1 (- ang12 (* pi 0.5)) (* 4.5 wid))
    
39.                    pt1 pt2
    
40.                    (polar pt2 (- ang12 (* pi 0.5)) (* 4.5 wid))
    
41.                    ""
    
42.   )
    
43.   (setvar "osmode" os)
    
44.   (princ)
    
45. )
    
46. (defun c:xj(/ os pt1 pt2 ang12)
    
47.   (setq os (getvar "osmode"))
    
48.   (setq wid 45)
    
49.   (setvar "plinewid" wid)
    
50.   (setvar "osmode" 0)
    
51.   (setq pt1 (getpoint "\n第一点:"))
    
52.   (setq pt2 (getpoint pt1 "\n第二点:"))
    
53.   (setq ang12 (angle pt1 pt2))
    
54.   (command "pline" (polar (polar pt1 (+ ang12 (* 0.5 pi)) (* 3.0 wid))
    
55.                           ang12 (* 4.5 wid)
    
56.                    )
    
57.                    (strcat "@" (rtos(* 3.0 wid)) "<" (rtos(+ (/ (* ang12 180.0) pi) 180)))
    
58.                    "a"
    
59.                    (strcat "@" (rtos(* 3.0 wid)) "<" (rtos(- (/ (* ang12 180.0) pi) 90)))
    
60.                    "l"
    
61.                    (polar pt2 (+ ang12 pi) (* 1.5 wid))
    
62.                    "a"
    
63.                    (strcat "@" (rtos(* 3.0 wid)) "<" (rtos(+ (/ (* ang12 180.0) pi) 90)))
    
64.                    "l"
    
65.                    (strcat "@" (rtos(* 3.0 wid)) "<" (rtos(+ (/ (* ang12 180.0) pi) 180)))
    
66.                    ""
    
67.   )
    
68.   (setvar "osmode" os)
    
69.   (princ)
    
70. )
    
71. 
    
72. 
    
73. (princ)
    
74.   [/FONT]
    

<br /> [CODE]<br />   [FONT=courier new]<br /> (defun c:tt(/ ss newtext i) <br />   (princ "\n旧文字:")<br />   (setq ss (ssget '((0 . "TEXT"))))<br />   (princ "\n新文字:")<br />   (setq newtext (getstring))<br />   (setq i 0)<br />   (repeat (sslength ss)<br />     (entmod (subst (cons 1 newtext) (assoc 1 (setq elist (entget (ssname ss i)))) elist))<br />     (setq i (1+ i))<br />   )<br />   (princ)<br /> )<br /> (defun c:ts(/ ss size i) <br />   (prompt "\n选取需改变高度的文字:")<br />   (setq ss (ssget '((0 . "TEXT"))))<br />   (princ "文字高度<") (princ (cdr(assoc 40 (entget (ssname ss 0))))) (princ ">:")<br />   (setq size (getdist))<br />   (if (not size) (setq size (cdr(assoc 40 (entget (ssname ss 0))))))<br />   (setq i 0)<br />   (repeat (sslength ss)<br />     (entmod (subst (cons 40 size) (assoc 40 (setq elist (entget (ssname ss i)))) elist))<br />     (setq i (+ 1 i))<br />   )<br />   (princ)<br /> )<br /> <br /> (defun c:sj(/ os pt1 pt2 ang12)<br />   (setq os (getvar "osmode"))<br />   (setvar "plinewid" 45)<br />   (setvar "osmode" 0)<br />   (setq pt1 (getpoint "\n第一点:"))<br />   (setq pt2 (getpoint pt1 "\n第二点:"))<br />   (setq ang12 (angle pt1 pt2) wid 45)<br />   (command "pline" (polar pt1 (- ang12 (* pi 0.5)) (* 4.5 wid))<br />                    pt1 pt2<br />                    (polar pt2 (- ang12 (* pi 0.5)) (* 4.5 wid))<br />                    ""<br />   )<br />   (setvar "osmode" os)<br />   (princ)<br /> )<br /> (defun c:xj(/ os pt1 pt2 ang12)<br />   (setq os (getvar "osmode"))<br />   (setq wid 45)<br />   (setvar "plinewid" wid)<br />   (setvar "osmode" 0)<br />   (setq pt1 (getpoint "\n第一点:"))<br />   (setq pt2 (getpoint pt1 "\n第二点:"))<br />   (setq ang12 (angle pt1 pt2))<br />   (command "pline" (polar (polar pt1 (+ ang12 (* 0.5 pi)) (* 3.0 wid))<br />                           ang12 (* 4.5 wid)<br />                    )<br />                    (strcat "@" (rtos(* 3.0 wid)) "<" (rtos(+ (/ (* ang12 180.0) pi) 180)))<br />                    "a" <br />                    (strcat "@" (rtos(* 3.0 wid)) "<" (rtos(- (/ (* ang12 180.0) pi) 90)))<br />                    "l"<br />                    (polar pt2 (+ ang12 pi) (* 1.5 wid))<br />                    "a"<br />                    (strcat "@" (rtos(* 3.0 wid)) "<" (rtos(+ (/ (* ang12 180.0) pi) 90)))<br />                    "l"<br />                    (strcat "@" (rtos(* 3.0 wid)) "<" (rtos(+ (/ (* ang12 180.0) pi) 180)))<br />                    ""<br />   )<br />   (setvar "osmode" os)<br />   (princ)<br /> )<br /> <br /> <br /> (princ)<br />   [/FONT]<br />

zxp

这个功能不错，建议加入。

陌生人

也可以用用find命令(cad2k以上版本)

Tong

费劲，用2000+以上的特性工具修改文字也可以统一的

lsjjm

最初由 快乐街 发布
[B]能编一个命令，将选中的所有不同文字变成同样的字[/B]

使用VLISP:
(defun c:test ()
  (vl-load-com)
  (setq ntext (getstring "\nNew Text: "))
  (prompt "\nSelect Text: ")
  (setq ss (ssget '((0 . "TEXT"))) n 0)
  (while (< n (sslength ss))
    (setq obj (vlax-ename->vla-object (ssname ss n)))
    (vla-put-textstring obj ntext)
    (setq n (1+ n))
  )
)

wuxi_jzsy

还有别的快捷方式吗？

Tong

最初由 wuxi_jzsy 发布
[B]还有别的快捷方式吗？ [/B]

iam0411

bonus工具条上有cht命令
r12也有的

myfreemind

find命令不也很方便嘛！

coolzhb

最初由 myfreemind 发布
[B]find命令不也很方便嘛！ [/B]

find命令不行，可以用论坛中的文字修改大师！

liujiping

这样还可以改标注中的
Sub DE()
Set ss = GetSelSet
If ss.Count = 1 Then
Set Ent = ss.Item(0)
If TypeOf Ent Is AcadMText Or TypeOf Ent Is AcadText Then
UserForm5.TextBox1.text = Ent.TextString
Else
On Error Resume Next
If Ent.TextOverride = "" Then
UserForm5.TextBox1.text = CInt(Ent.Measurement)
Else
UserForm5.TextBox1.text = CInt(Ent.TextOverride)
End If

End If
End If
UserForm5.Show
s = Trim(UserForm5.TextBox1.text)
control = UserForm5.TextBox2.text '判断用
If control = 2 Then Exit Sub
For Each Ent In ss
If TypeOf Ent Is AcadDimAngular Then
Ent.TextOverride = s
ElseIf TypeOf Ent Is AcadDimRotated Then
Ent.TextOverride = s
ElseIf TypeOf Ent Is AcadDimRadial Then
Ent.TextOverride = s
ElseIf TypeOf Ent Is AcadDimAligned Then
Ent.TextOverride = s
ElseIf TypeOf Ent Is AcadDim3PointAngular Then
Ent.TextOverride = s
ElseIf TypeOf Ent Is AcadDimDiametric Then
Ent.TextOverride = s
ElseIf TypeOf Ent Is AcadMText Then
Ent.TextString = s
ElseIf TypeOf Ent Is AcadText Then
Ent.TextString = s
End If
Next
End Sub

liyer

不好用，我还是用FIND命令好了