求助代码修改

yangchao2005090

下面是论坛上的代码，文字查找并标记，如何改一下实现：
新建图层aa，并把标记放图层aa上

2. ;;http://bbs.mjtd.com/forum.php?mod=viewthread&tid=175593&extra=&highlight=%B2%E9%D5%D2&page=2
   
3. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   
4. ;;查找文字2017.09.04增加通配符
   
5. (defun czt (sst hand1 / filter sst ss enttxt po ptmid i SearchTXT)
   
6.   (if sst
   
7.     (progn ;_1
   
8.       (setq filter (list '(0 . "*TEXT") (cons 1 sst)))
   
9.       (if (= hand1 "1")
   
10.         (setq ss (ssget "x" (list '(0 . "*TEXT") (cons 1 sst))))
    
11.         (setq ss (ssget (list '(0 . "*TEXT") (cons 1 sst))))
    
12.       )
    
13.       (if (and (= radio1 "1") ss);
    
14.         (progn
    
15.           ;;;   (setq basepoint (getpoint "\n指定线段发射基点:"))
    
16.           (setq entPtLst '())
    
17.           (setq i 0)
    
18.           (repeat (sslength ss)
    
19.             (setq enttxt (ssname ss i))
    
20.             (setq po (cdr (assoc 10 (entget enttxt))))
    
21.             (setq ptmid (getmidpo (entbox enttxt)))
    
22.             (setq entPtLst (cons ptmid entPtLst))
    
23.             ;;;   (if basepoint
    
24.             ;;;    (entmakex (list '(0 . "line") '(100 . "AcDbEntity") '
    
25.             ;;;               (100 . "ACDbCircle") (cons 8 "-文字线")(cons 10 ptmid)
    
26.             ;;;               (cons 11 basepoint)(cons 62 1) '(210 0. 0. 1.))
    
27.             ;;;  )
    
28.             ;;;    )
    
29.             (setq i (+ 1 i))
    
30.           )
    
31.           ;;;    (princ (strcat "成功处理：" (rtos i) "个对象"))
    
32.           (setq SearchTXT (strcat "成功查找：" findtxt  " 共"(rtos i 5) "个对象"))
    
33.           (dynamicMTxt SearchTXT 8 entPtLst)
    
34.         )
    
35.         ;(princ "\n没有找到对象!")
    
36.       )
    
37.       (if (and (= radio2 "1") ss)
    
38.         (sssetfirst nil ss)
    
39.       )
    
40.     ) ;_progn 1
    
41.     (alert "\n您没有选择文字哦!!!")
    
42.   )
    
43.   ;(endcmd)
    
44.   (princ)
    
45. )
    
46. (defun textstring_find ( / $value Return enttxt findtxt idcl_idtxt po ptmid @dclfiledame)
    
47.   (defun write-dialog (dialog_string_1st / @dclfiledame @dclfiled)
    
48.     (setq @dclfiledame (vl-filename-mktemp nil nil ".dcl"))
    
49.     (setq @dclfiled (open @dclfiledame "w"))
    
50.     (foreach x dialog_string_1st
    
51.       (write-line x @dclfiled)
    
52.     )
    
53.     (close @dclfiled)
    
54.     @dclfiledame
    
55.   )
    
56.   (setq findtext:dialog-lst
    
57.     (list
    
58.       "findtext:dialog{"
    
59.       "//:text{label="支持通配符*查找";is_enabled = false;}"
    
60.       "label="文字查找";"
    
61.       ":column{//label="文字";boxed_row"
    
62.       ":row{"
    
63.       "label = "是否做标记";"
    
64.       ":row{"
    
65.       ":radio_button{label="是";key="radio1";}"
    
66.       ":radio_button{label="否";key="radio2";}"
    
67.       "}"
    
68.       ":toggle{label="加前通配符";key="tog1";}"
    
69.       ":toggle{label="加后通配符";key="tog2";}"
    
70.       ":toggle{label="全图";key="hand1";}"
    
71.       "}"
    
72.       ":row{"
    
73.       "label = "文本输入";"
    
74.       ":column{"
    
75.       ":edit_box{label="输入文字:";"
    
76.       "initial_focus="text2";"
    
77.       "key="text2";"
    
78.       "edit_width=30;"
    
79.       "fixed_width=true;  "
    
80.       "}"
    
81.       "}                                                                                    "
    
82.       "}   //column"
    
83.       "}   //boxed_row"
    
84.       "//:text{label="Design by:半途中 QQ:455383153";is_enabled = false;}"
    
85.       "ok_cancel;"
    
86.       "}"
    
87.     )
    
88.   )
    
89.   (setq @dclfiledame(write-dialog findtext:dialog-lst))
    
90.   (if (and (= radio1 nil) (= radio2 nil))
    
91.     (setq  radio1 "1"
    
92.       radio2 "0"
    
93.     )
    
94.   )
    
95.   (if (not tog1)
    
96.     (setq tog1 "0")
    
97.   )
    
98.   (if (not tog2)
    
99.     (setq tog2 "0")
    
100.   )
     
101.   (if (not hand1)
     
102.     (setq hand1 "0")
     
103.   )
     
104.   (if (not text2findtxt_name)
     
105.     (setq text2findtxt_name "请输入查找的文字")
     
106.   )
     
107.   (prompt "\n请选择：")
     
108.   (setq idcl_idtxt (load_dialog @dclfiledame))
     
109.   (new_dialog "findtext" idcl_idtxt)
     
110.   (set_tile "text2" text2findtxt_name)
     
111.   (set_tile "radio1" radio1)
     
112.   (set_tile "radio2" radio2)
     
113.   (set_tile "tog1" tog1)
     
114.   (set_tile "tog2" tog2)
     
115.   (set_tile "hand1" hand1)
     
116.   (mode_tile "text2" 2)
     
117.   (action_tile "radio1" "(setq radio1 (vl-princ-to-string 1))(setq radio2  (vl-princ-to-string 0) )")
     
118.   (action_tile "radio2" "(setq radio2 (vl-princ-to-string 1))(setq radio1 (vl-princ-to-string 0))")
     
119.   (action_tile "tog1" "(setq tog1 $value)")
     
120.   (action_tile "tog2" "(setq tog2 $value)")
     
121.   (action_tile "hand1" "(setq hand1 $value)")
     
122.   (action_tile "text2" "(setq text2findtxt_name (get_tile "text2"))")
     
123.   (action_tile "accept" "(done_dialog 1)")
     
124.   (action_tile "cancel" "(done_dialog 0)")
     
125.   (setq Return (start_dialog))
     
126.   (unload_dialog idcl_idtxt)
     
127.   (vl-file-delete @dclfiledame)
     
128.   (IF (= Return 1)
     
129.     (progn
     
130.       (if (and (= tog1 "1") (= tog2 "1"))
     
131.         (setq findtxt (strcat "*" text2findtxt_name "*"))
     
132.       )
     
133.       (if (and (= tog1 "1") (= tog2 "0"))
     
134.         (setq findtxt (strcat "*" text2findtxt_name))
     
135.       )
     
136.       (if (and (= tog1 "0") (= tog2 "1"))
     
137.         (setq findtxt (strcat text2findtxt_name "*"))
     
138.       )
     
139.       (if (and (= tog1 "0") (= tog2 "0"))
     
140.         (setq findtxt text2findtxt_name)
     
141.       )
     
142.       (czt findtxt hand1)
     
143.     )
     
144.   )
     
145.   (princ)
     
146. );;;defun
     
147. ;;单个物体的最小（正交）包围框
     
148. (defun entbox (ent / ll ur)
     
149.   (vl-load-com)
     
150.   (vla-getboundingbox (vlax-ename->vla-object ent) 'll 'ur)
     
151.   (mapcar 'vlax-safearray->list (list ll ur))
     
152. )
     
153. ;;求两点中点
     
154. (defun getmidpo  (pts / P1 P2 X Y)
     
155.   (setq  p1 (car pts)
     
156.     p2 (cadr pts)
     
157.   )
     
158.   (if (= (length p1) (length p2))
     
159.     nil
     
160.     (setq p1 (list (car p1) (cadr p1))
     
161.       p2 (list (car p2) (cadr p2))
     
162.     )
     
163.   )
     
164.   (mapcar '(lambda (X Y) (* (+ X Y) 0.5)) P1 P2)
     
165. )
     
166. (defun dynamicMTxt (MtextStr high pntlst / entlist pt CNTNNEW MOUSE MseButton ENT MsePt);_by wizman
     
167.   (setq entlist '())
     
168.   (foreach x pntlst
     
169.     (setq pt x)
     
170.     (setq entlist (cons (MkRedLine x pt) entlist))
     
171.   )
     
172.   (entmake (list '(0 . "MTEXT") '(100 . "AcDbEntity") '(100 . "AcDbMText") '(7 . "Standard")(CONS 40 high) (cons 62 3)(cons 1 MtextStr) (cons 10 (cadr (grread t 13 1)))))
     
173.   (setq CnTnNew t)
     
174.   (while (and (or (= (car (setq mouse (grread t 13 1))) 5)
     
175.                 (= (car mouse) 12)
     
176.                 (= (car mouse) 2)
     
177.               )
     
178.            CnTnNew
     
179.          )
     
180.     ;_ 所谓grread函数就是不断重新画图，直到给点为止。
     
181.     (setq MseButton (car mouse))
     
182.     (if  (= MseButton 2) ;_点右键
     
183.       (setq CnTnNew nil)
     
184.     )
     
185.     (if  (= MseButton 3) ;_点左键3为正常的鼠标左键，
     
186.       (setq CnTnNew nil)
     
187.     )
     
188.     (if  (= MseButton 5) ;_5为移动点
     
189.       (progn
     
190.         (setq ent (entlast))
     
191.         (if ent
     
192.           (entdel ent)
     
193.         )
     
194.         (setq MsePt (cadr mouse))
     
195.         (entmake (list '(0 . "MTEXT") '(100 . "AcDbEntity") '(100 . "AcDbMText") '(7 . "Standard")(CONS 40 high)(cons 62 3) (cons 1 MtextStr) (cons 10 MsePt)))
     
196.         (foreach x entlist
     
197.           (upd x 11 MsePt)
     
198.           (not (redraw x 3))
     
199.         )
     
200.       ) ;_progn
     
201.     );_if
     
202.   ) ;_while
     
203.   (princ)
     
204. )
     
205. (defun MKRedLine(pt1 pt2)
     
206.   (entmakex (list '(0 . "LINE") (cons 62 1)(cons 10 pt1) (cons 11 pt2)))
     
207. )
     
208. ;;更新组码值
     
209. (defun upd (e i v / a)
     
210.   (setq e (entget e))
     
211.   (if (setq a (assoc i e))
     
212.     (entmod (subst (cons i v) a e))
     
213.   )
     
214. )
     
215. (princ)
     
216. (princ"\n字符查找,命令TTF")
     
217. (defun c:ttf ()(textstring_find))

;;http://bbs.mjtd.com/forum.php?mod=viewthread&tid=175593&extra=&highlight=%B2%E9%D5%D2&page=2<br /> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<br /> ;;查找文字2017.09.04增加通配符<br /> (defun czt (sst hand1 / filter sst ss enttxt po ptmid i SearchTXT)<br />   (if sst<br />     (progn ;_1<br />       (setq filter (list '(0 . "*TEXT") (cons 1 sst)))<br />       (if (= hand1 "1")<br />         (setq ss (ssget "x" (list '(0 . "*TEXT") (cons 1 sst))))<br />         (setq ss (ssget (list '(0 . "*TEXT") (cons 1 sst))))<br />       )<br />       (if (and (= radio1 "1") ss);<br />         (progn<br />           ;;;   (setq basepoint (getpoint "\n指定线段发射基点:"))<br />           (setq entPtLst '())<br />           (setq i 0)<br />           (repeat (sslength ss)<br />             (setq enttxt (ssname ss i))<br />             (setq po (cdr (assoc 10 (entget enttxt))))<br />             (setq ptmid (getmidpo (entbox enttxt)))<br />             (setq entPtLst (cons ptmid entPtLst))<br />             ;;;   (if basepoint<br />             ;;;    (entmakex (list '(0 . "line") '(100 . "AcDbEntity") '<br />             ;;;               (100 . "ACDbCircle") (cons 8 "-文字线")(cons 10 ptmid)<br />             ;;;               (cons 11 basepoint)(cons 62 1) '(210 0. 0. 1.))<br />             ;;;  )<br />             ;;;    )<br />             (setq i (+ 1 i))<br />           )<br />           ;;;    (princ (strcat "成功处理：" (rtos i) "个对象"))<br />           (setq SearchTXT (strcat "成功查找：" findtxt  " 共"(rtos i 5) "个对象"))<br />           (dynamicMTxt SearchTXT 8 entPtLst)<br />         )<br />         ;(princ "\n没有找到对象!")<br />       )<br />       (if (and (= radio2 "1") ss)<br />         (sssetfirst nil ss)<br />       )<br />     ) ;_progn 1<br />     (alert "\n您没有选择文字哦!!!")<br />   )<br />   ;(endcmd)<br />   (princ)<br /> )<br /> (defun textstring_find ( / $value Return enttxt findtxt idcl_idtxt po ptmid @dclfiledame)<br />   (defun write-dialog (dialog_string_1st / @dclfiledame @dclfiled)<br />     (setq @dclfiledame (vl-filename-mktemp nil nil ".dcl"))<br />     (setq @dclfiled (open @dclfiledame "w"))<br />     (foreach x dialog_string_1st<br />       (write-line x @dclfiled)<br />     )<br />     (close @dclfiled)<br />     @dclfiledame<br />   )<br />   (setq findtext:dialog-lst<br />     (list<br />       "findtext:dialog{"<br />       "//:text{label="支持通配符*查找";is_enabled = false;}"<br />       "label="文字查找";"<br />       ":column{//label="文字";boxed_row"<br />       ":row{"<br />       "label = "是否做标记";"<br />       ":row{"<br />       ":radio_button{label="是";key="radio1";}"<br />       ":radio_button{label="否";key="radio2";}"<br />       "}"<br />       ":toggle{label="加前通配符";key="tog1";}"<br />       ":toggle{label="加后通配符";key="tog2";}"<br />       ":toggle{label="全图";key="hand1";}"<br />       "}"<br />       ":row{"<br />       "label = "文本输入";"<br />       ":column{"<br />       ":edit_box{label="输入文字:";"<br />       "initial_focus="text2";"<br />       "key="text2";"<br />       "edit_width=30;"<br />       "fixed_width=true;  "<br />       "}"<br />       "}                                                                                    "<br />       "}   //column"<br />       "}   //boxed_row"<br />       "//:text{label="Design by:半途中 QQ:455383153";is_enabled = false;}"<br />       "ok_cancel;"<br />       "}"<br />     )<br />   )<br />   (setq @dclfiledame(write-dialog findtext:dialog-lst))<br />   (if (and (= radio1 nil) (= radio2 nil))<br />     (setq  radio1 "1"<br />       radio2 "0"<br />     )<br />   )<br />   (if (not tog1)<br />     (setq tog1 "0")<br />   )<br />   (if (not tog2)<br />     (setq tog2 "0")<br />   )<br />   (if (not hand1)<br />     (setq hand1 "0")<br />   )<br />   (if (not text2findtxt_name)<br />     (setq text2findtxt_name "请输入查找的文字")<br />   )<br />   (prompt "\n请选择：")<br />   (setq idcl_idtxt (load_dialog @dclfiledame))<br />   (new_dialog "findtext" idcl_idtxt)<br />   (set_tile "text2" text2findtxt_name)<br />   (set_tile "radio1" radio1)<br />   (set_tile "radio2" radio2)<br />   (set_tile "tog1" tog1)<br />   (set_tile "tog2" tog2)<br />   (set_tile "hand1" hand1)<br />   (mode_tile "text2" 2)<br />   (action_tile "radio1" "(setq radio1 (vl-princ-to-string 1))(setq radio2  (vl-princ-to-string 0) )")<br />   (action_tile "radio2" "(setq radio2 (vl-princ-to-string 1))(setq radio1 (vl-princ-to-string 0))")<br />   (action_tile "tog1" "(setq tog1 $value)")<br />   (action_tile "tog2" "(setq tog2 $value)")<br />   (action_tile "hand1" "(setq hand1 $value)")<br />   (action_tile "text2" "(setq text2findtxt_name (get_tile "text2"))")<br />   (action_tile "accept" "(done_dialog 1)")<br />   (action_tile "cancel" "(done_dialog 0)")<br />   (setq Return (start_dialog))<br />   (unload_dialog idcl_idtxt)<br />   (vl-file-delete @dclfiledame)<br />   (IF (= Return 1)<br />     (progn<br />       (if (and (= tog1 "1") (= tog2 "1"))<br />         (setq findtxt (strcat "*" text2findtxt_name "*"))<br />       )<br />       (if (and (= tog1 "1") (= tog2 "0"))<br />         (setq findtxt (strcat "*" text2findtxt_name))<br />       )<br />       (if (and (= tog1 "0") (= tog2 "1"))<br />         (setq findtxt (strcat text2findtxt_name "*"))<br />       )<br />       (if (and (= tog1 "0") (= tog2 "0"))<br />         (setq findtxt text2findtxt_name)<br />       )<br />       (czt findtxt hand1)<br />     )<br />   )<br />   (princ)<br /> );;;defun<br /> ;;单个物体的最小（正交）包围框<br /> (defun entbox (ent / ll ur)<br />   (vl-load-com)<br />   (vla-getboundingbox (vlax-ename->vla-object ent) 'll 'ur)<br />   (mapcar 'vlax-safearray->list (list ll ur))<br /> )<br /> ;;求两点中点<br /> (defun getmidpo  (pts / P1 P2 X Y)<br />   (setq  p1 (car pts)<br />     p2 (cadr pts)<br />   )<br />   (if (= (length p1) (length p2))<br />     nil<br />     (setq p1 (list (car p1) (cadr p1))<br />       p2 (list (car p2) (cadr p2))<br />     )<br />   )<br />   (mapcar '(lambda (X Y) (* (+ X Y) 0.5)) P1 P2)<br /> )<br /> (defun dynamicMTxt (MtextStr high pntlst / entlist pt CNTNNEW MOUSE MseButton ENT MsePt);_by wizman<br />   (setq entlist '())<br />   (foreach x pntlst<br />     (setq pt x)<br />     (setq entlist (cons (MkRedLine x pt) entlist))<br />   )<br />   (entmake (list '(0 . "MTEXT") '(100 . "AcDbEntity") '(100 . "AcDbMText") '(7 . "Standard")(CONS 40 high) (cons 62 3)(cons 1 MtextStr) (cons 10 (cadr (grread t 13 1)))))<br />   (setq CnTnNew t)<br />   (while (and (or (= (car (setq mouse (grread t 13 1))) 5)<br />                 (= (car mouse) 12)<br />                 (= (car mouse) 2)<br />               )<br />            CnTnNew<br />          )<br />     ;_ 所谓grread函数就是不断重新画图，直到给点为止。<br />     (setq MseButton (car mouse))<br />     (if  (= MseButton 2) ;_点右键<br />       (setq CnTnNew nil)<br />     )<br />     (if  (= MseButton 3) ;_点左键3为正常的鼠标左键，<br />       (setq CnTnNew nil)<br />     )<br />     (if  (= MseButton 5) ;_5为移动点<br />       (progn<br />         (setq ent (entlast))<br />         (if ent<br />           (entdel ent)<br />         )<br />         (setq MsePt (cadr mouse))<br />         (entmake (list '(0 . "MTEXT") '(100 . "AcDbEntity") '(100 . "AcDbMText") '(7 . "Standard")(CONS 40 high)(cons 62 3) (cons 1 MtextStr) (cons 10 MsePt)))<br />         (foreach x entlist<br />           (upd x 11 MsePt)<br />           (not (redraw x 3))<br />         )<br />       ) ;_progn<br />     );_if<br />   ) ;_while<br />   (princ)<br /> )<br /> (defun MKRedLine(pt1 pt2)<br />   (entmakex (list '(0 . "LINE") (cons 62 1)(cons 10 pt1) (cons 11 pt2)))<br /> )<br /> ;;更新组码值<br /> (defun upd (e i v / a)<br />   (setq e (entget e))<br />   (if (setq a (assoc i e))<br />     (entmod (subst (cons i v) a e))<br />   )<br /> )<br /> (princ)<br /> (princ"\n字符查找,命令TTF")<br /> (defun c:ttf ()(textstring_find))

风流少年时

替换后面的TTF，按理来说你都是金牌会员了不应该不会啊
(defun c:ttf ()
        (SETVAR "CMDECHO" 0)
        (command "-layer" "m" "aa" "c" 1 ""  "L" "continuous" "" "")
        (textstring_find)
)