[求助]：一个很好用的程序，请大家帮忙修改一下，程序如下

寒光四射

(defun c:chazhao()        ;根据权属人姓名查找地块位置且居中显示
(setq syscmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq qsr (getstring "\n请输入权属人姓名："))
(setq ssp nil cord nil)
(setq ssp (ssget "x" (list (cons 0 "text") (cons 1 qsr))))
(if (/= ssp nil)
    (progn
    (setq i 0)
    (while  (< i (sslength ssp))
         (setq cord (cdr (assoc 10 (entget (ssname ssp i) ))))
               (command "zoom" "c" cord 20)
               ;(redraw  (ssname ssp i) 3)
               (if (> (sslength ssp) 1)
               (setq aia (getstring "\n 继续...请按ENTER：")))
               (setq i (+ i 1))
       );while
      
))
(if (= ssp nil)
    (progn
          (princ "\n    权属人:  ")
          (princ qsr)
          (princ " 没有找到!请确认后重新输入...")
    ))
(setvar "cmdecho" syscmd)
(princ)
)

上述实现了查找，
比如存在‘张三’，输入‘张三’就可以查找
但是，输入‘三’就不行，
现在如何改进，实现模糊查询，比如输入‘三’就可以查处关于‘三’的名字呢？谢谢

Underway

(setq ssp (ssget "x" (list (cons 0 "text") (cons 1 qsr))))
====>
(setq ssp (ssget "x" '((0 .  "text") (1 .  "*三*"))))

不过可要处理衍生的问题.....

zml84

2. 
   
3. ;;;=============================================================================
   
4. ;;;改进后：模糊查询
   
5. (defun C:TT (/ CMD_OLD E I LST NAME PT SS STR)
   
6.     (princ "\n**在"TEXT"对象中模糊查询**")
   
7.     ;;
   
8.     (setq CMD_OLD (getvar "CMDECHO"))
   
9.     (setvar "CMDECHO" 0)
   
10.     ;;
    
11.     (if        (and (/= (setq NAME (getstring "\n请输入查询内容：")) "")
    
12.              (or (setq SS (ssget "x"
    
13.                                  (list (cons 0 "TEXT") (cons 1 NAME))
    
14.                           )
    
15.                  )
    
16. ;;;                 (setq SS (ssget "x"
    
17. ;;;                                 (list (cons 0 "TEXT")
    
18. ;;;                                       (cons 1 (strcat NAME "*"))
    
19. ;;;                                 )
    
20. ;;;                          )
    
21. ;;;                 )
    
22. ;;;                 (setq SS (ssget "x"
    
23. ;;;                                 (list (cons 0 "TEXT")
    
24. ;;;                                       (cons 1 (strcat "*" NAME))
    
25. ;;;                                 )
    
26. ;;;                          )
    
27. ;;;                 )
    
28.                  (setq SS (ssget "x"
    
29.                                  (list (cons 0 "TEXT")
    
30.                                        (cons 1 (strcat "*" NAME "*"))
    
31.                                  )
    
32.                           )
    
33.                  )
    
34.              )
    
35.         )
    
36.         (progn
    
37.             ;;组建排序表
    
38.             ;;其格式为：((字符长度 字符 点位)()...)
    
39.             (setq LST '()
    
40.                   I   0
    
41.             )
    
42.             (repeat (sslength SS)
    
43.                 (setq E          (ssname SS I)
    
44.                       STR (cdr (assoc 1 (entget E)))
    
45.                       PT  (cdr (assoc 10 (entget E)))
    
46.                 )
    
47.                 (setq LST (cons (list (strlen STR) STR PT E) LST))
    
48.                 (setq I (1+ I))
    
49.             ) ;_结束repeat
    
50.             ;;排序
    
51.             (setq LST (vl-sort LST
    
52.                                (function (lambda (E1 E2)
    
53.                                              (< (car E1) (car E2))
    
54.                                          )
    
55.                                )
    
56.                       )
    
57.             )
    
58.             ;;逐个显示
    
59.             (foreach N LST
    
60.                 (progn
    
61.                     (command "._pan" (caddr N) (getvar "VIEWCTR"))
    
62.                     (redraw (last N) 3)
    
63.                     (princ "\n找到内容: "")
    
64.                     (princ (cadr N))
    
65.                     (getstring "" 请按空格键继续...: ")
    
66.                     (redraw (last N)4)
    
67.                 )
    
68.             ) ;_结束foreach
    
69.         )
    
70.         (princ "\n没有找到!")
    
71.     )
    
72.     ;;
    
73.     (setvar "CMDECHO" CMD_OLD)
    
74.     (princ)
    
75. );_结束defun
    

<br /> ;;;=============================================================================<br /> ;;;改进后：模糊查询<br /> (defun C:TT (/ CMD_OLD E I LST NAME PT SS STR)<br />     (princ "\n**在"TEXT"对象中模糊查询**")<br />     ;;<br />     (setq CMD_OLD (getvar "CMDECHO"))<br />     (setvar "CMDECHO" 0)<br />     ;;<br />     (if        (and (/= (setq NAME (getstring "\n请输入查询内容：")) "")<br />              (or (setq SS (ssget "x"<br />                                  (list (cons 0 "TEXT") (cons 1 NAME))<br />                           )<br />                  )<br /> ;;;                 (setq SS (ssget "x"<br /> ;;;                                 (list (cons 0 "TEXT")<br /> ;;;                                       (cons 1 (strcat NAME "*"))<br /> ;;;                                 )<br /> ;;;                          )<br /> ;;;                 )<br /> ;;;                 (setq SS (ssget "x"<br /> ;;;                                 (list (cons 0 "TEXT")<br /> ;;;                                       (cons 1 (strcat "*" NAME))<br /> ;;;                                 )<br /> ;;;                          )<br /> ;;;                 )<br />                  (setq SS (ssget "x"<br />                                  (list (cons 0 "TEXT")<br />                                        (cons 1 (strcat "*" NAME "*"))<br />                                  )<br />                           )<br />                  )<br />              )<br />         )<br />         (progn<br />             ;;组建排序表<br />             ;;其格式为：((字符长度 字符 点位)()...)<br />             (setq LST '()<br />                   I   0<br />             )<br />             (repeat (sslength SS)<br />                 (setq E          (ssname SS I)<br />                       STR (cdr (assoc 1 (entget E)))<br />                       PT  (cdr (assoc 10 (entget E)))<br />                 )<br />                 (setq LST (cons (list (strlen STR) STR PT E) LST))<br />                 (setq I (1+ I))<br />             ) ;_结束repeat<br />             ;;排序<br />             (setq LST (vl-sort LST<br />                                (function (lambda (E1 E2)<br />                                              (< (car E1) (car E2))<br />                                          )<br />                                )<br />                       )<br />             )<br />             ;;逐个显示<br />             (foreach N LST<br />                 (progn<br />                     (command "._pan" (caddr N) (getvar "VIEWCTR"))<br />                     (redraw (last N) 3)<br />                     (princ "\n找到内容: "")<br />                     (princ (cadr N))<br />                     (getstring "" 请按空格键继续...: ")<br />                     (redraw (last N)4)<br />                 )<br />             ) ;_结束foreach<br />         )<br />         (princ "\n没有找到!")<br />     )<br />     ;;<br />     (setvar "CMDECHO" CMD_OLD)<br />     (princ)<br /> );_结束defun<br />

代码着色显示效果，见：http://zml84.blog.sohu.com/64529687.html

bfz1982

支持zml!

它山之石

FIND

它山之石

FIND

守仁格竹GM

很不错的说