[LISP程序]：请帮忙修改一下程序

wcf

我在网上收集到的一个程序，可以选择文字改至目标层。但是选择文字没有匹配功能，如选择2至某一层，它可以把2,21,200等第一个字母为2的文字都改至某一层，这样用起来就不方便了，请哪一位热心人把此程序修改一下，加入匹配功能，以及显示选择了多少个数的功能，不胜感谢！
;*********************************************************************
;From the DESK of PAUL Standing
; String search and Layer changer V 1.0 March 23 1995
; Routine changes selected text to specified layer
;**********************************************************************
(defun c:stext(/ sset len i st_search lay_to type name sub_st1
cur_lay new_lay ent_new)

(setq sset (ssget "x" (list (cons 0 "TEXT"))))
(setq len (sslength sset))
(setq i 0)
(setq st_search (getstring "\nEnter Search Parameter: "))
(setq search (strcat "*" st_search "*"))
(setq lay_to (getstring "\nEnter destination layer: "))
(if (= (tblsearch "layer" lay_to) nil)
    (command "layer" "N" lay_to "")
)
(setq l (strlen st_search))


        (while (< i len)
               (setq type (ssname sset i))
               (setq name (entget type))
               (setq sub_st1 (assoc 1 name))
               (setq sub_st (cdr sub_st1))
               

; If statement to check if string begins with search parameters

                (if (wcmatch sub_st search )
                    (progn
                    (setq type (ssname sset i))
                    (setq name (entget type))
                    (setq cur_lay(assoc 8 name))
                    (setq new_lay(cons 8 lay_to))
                    (setq ent_new (subst new_lay cur_lay name))
                    (entmod ent_new)   
                    )
                )
               (setq i (+ 1 i))
         )       
      
(princ)
(princ)
)
(prompt "\nType stext to envoke the command")

lt_zzy

(defun c:stext(/ sset len i st_search lay_to type name sub_st1
cur_lay new_lay ent_new)

(setq sset (ssget "x" (list (cons 0 "TEXT"))))   
(setq len (sslength sset))                        
(setq i 0)
(setq st_search (getstring "\nEnter Search Parameter: "))
(setq lay_to (getstring "\nEnter destination layer: "))   
(if (= (tblsearch "layer" lay_to) nil)                    
  (command "layer" "N" lay_to "")
)
(setq l (strlen st_search))                              


(while (< i len)
  (setq type (ssname sset i))                             
  (setq name (entget type))                              
  (setq sub_st1 (assoc 1 name))                           
  (setq sub_st (cdr sub_st1))                             


; If statement to check if string begins with search parameters

  (if (= sub_st st_search )
    (progn
      (setq cur_lay(assoc 8 name))
      (setq new_lay(cons 8 lay_to))
      (setq ent_new (subst new_lay cur_lay name))
      (entmod ent_new)
    )
  )
  (setq i (+ 1 i))
)

(princ)
(princ)
)
(prompt "\nType stext to envoke the command")

wcf

楼上兄弟你好，谢谢你的帮助，我下载试用了，很好，能不能加入显示转换文字数的功能。

lt_zzy

(defun c:stext(/ sset len i st_search lay_to type name sub_st1
cur_lay new_lay ent_new ent_nu)

(setq sset (ssget "x" (list (cons 0 "TEXT"))))   
(setq len (sslength sset))                        
(setq i 0 ent_nu 0)
(setq st_search (getstring "\nEnter Search Parameter: "))
(setq lay_to (getstring "\nEnter destination layer: "))   
(if (= (tblsearch "layer" lay_to) nil)                    
  (command "layer" "N" lay_to "")
)
(setq l (strlen st_search))                              


(while (< i len)
  (setq type (ssname sset i))                             
  (setq name (entget type))                              
  (setq sub_st1 (assoc 1 name))                           
  (setq sub_st (cdr sub_st1))                             


; If statement to check if string begins with search parameters

  (if (= sub_st st_search )
    (progn
      (setq cur_lay(assoc 8 name))
      (setq new_lay(cons 8 lay_to))
      (setq ent_new (subst new_lay cur_lay name))
      (entmod ent_new)
      (setq ent_nu (1+ ent_nu))
    )
  )
  (setq i (+ 1 i))
)
(princ "\n")
(princ (strcat (rtos ent_nu 2 0) " text(s) converted"))
(princ)
)
(prompt "\nType stext to envoke the command")

wcf

没想到改的这样快，谢谢了，LISP我是一个外行，现在觉得很有用，由于工作很忙，一直没有时间学习，现在也想坐下来学一学，不知道好不好学，从入门到初步能写不知要投入多少精力？
刚才下载运行后（R14)，在命令行出现一行提示extra right paren*Cancel*，不知什么原因，另外再次加载时，不再执行命令，用appload也无法加载。

lijiao

是括号不配对。
＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
可以在VL环境中进行检查，很方便的。

lt_zzy

我在我的机子上可以用，可能是上传的时候漏了括号。
下面我再上传一次。

(defun c:stext(/ sset len i st_search lay_to type name sub_st1
cur_lay new_lay ent_new ent_nu)

(setq sset (ssget "x" (list (cons 0 "TEXT"))))   
(setq len (sslength sset))                        
(setq i 0 ent_nu 0)
(setq st_search (getstring "\nEnter Search Parameter: "))
(setq lay_to (getstring "\nEnter destination layer: "))   
(if (= (tblsearch "layer" lay_to) nil)                    
  (command "layer" "N" lay_to "")
)
(setq l (strlen st_search))                              

(while (< i len)
  (setq type (ssname sset i))                             
  (setq name (entget type))                              
  (setq sub_st1 (assoc 1 name))                           
  (setq sub_st (cdr sub_st1))                             


; If statement to check if string begins with search parameters

  (if (= sub_st st_search )
    (progn
      (setq cur_lay(assoc 8 name))
      (setq new_lay(cons 8 lay_to))
      (setq ent_new (subst new_lay cur_lay name))
      (entmod ent_new)
      (setq ent_nu (1+ ent_nu))
    )
  )
  (setq i (+ 1 i))
)
(princ "\n")
(princ (strcat (rtos ent_nu 2 0) " text(s) converted"))
(princ)
)
(prompt "\nType stext to envoke the command")

wcf

谢谢！好用了。