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

寒光四射 · 发表于 2007-9-19 21:01:52

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

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

×

(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 ( (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 · 发表于 2007-9-19 21:23:35

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

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

zml84 · 发表于 2007-9-20 00:07:30

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

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

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

bfz1982 · 发表于 2007-9-20 04:43:44

支持zml!

它山之石 · 发表于 2007-9-20 09:31:57

FIND

它山之石 · 发表于 2007-9-20 09:37:42

FIND

守仁格竹GM · 发表于 2013-5-13 15:46:58

很不错的说

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

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

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

相关帖子