[编程交流] 选择文字LISP

;; RNZERO.LSP
;; Fatty T.O.H () 2006 * all rights removed
;; renumbering stations 
;; (partialy borrowed from
;; REGEXP.LSP
;; Copyright (c) 2004, Tony Tanzillo)
(defun C:RNZERO (/ *error* *debug* init match maxlen match_list newstr newtxt newvalue
        numadd obj_list oldtxt regex result ss)
;; error trapping function
;; based on function
;; published by Joe Burke 12/5/2005
(defun *error*  (msg)     ; create standard error handler
     (cond ((not msg))      ; normal exit, no error
    ((member msg '("Function cancelled" "quit / exit abort"))) ; escape
    ((princ (strcat "\nError: " msg))   ; display fatal error
     (cond (*debug* (vl-bt)))))    ; if in debug mode, dump backtrace
  (vl-catch-all-apply
     (function(lambda()
(vlax-release-object result))))
   (vl-catch-all-apply
     (function(lambda()
(vlax-release-object regex))))
     (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
     )
(vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))  
(if
 (not
   (vl-catch-all-error-p
     (vl-catch-all-apply
(function
  (lambda ()
    (setq regex (vlax-create-object "VBScript.RegExp")))))))
  (progn
    (vlax-put-property regex 'Global :vlax-true)
    (vlax-put-property regex 'IgnoreCase :vlax-true)
    (setq init (getstring "\Enter initial value to find <001> : "))
    (if (eq "" init)
        (setq init "001"))
    (initget 6)
    (setq numadd (getint "\nNumber to add <20> : "))
    (if (not numadd)
      (setq numadd 20))
    (setq maxlen (strlen init)
   match  "")
    (if
      (setq ss (ssget (list
   (cons 0 "TEXT")
   (cons 1
         (strcat "*"
          (repeat maxlen
     (setq match (strcat match "#")))
          "*")))))
(progn
  (setq match_list
  (mapcar 'cons
  (setq obj_list  
  (mapcar 'vlax-ename->vla-object
   (vl-remove-if
     'listp
     (mapcar 'cadr
      (ssnamex ss)
      )
     )
   )
 )
   (mapcar 'vla-get-textstring obj_list))
  )
  (while (setq obj_list (vl-remove-if-not
  (function (lambda (x)
       (wcmatch (cdr x) (strcat "*" init "*"))))
       match_list)
   )
    (vlax-put-property regex 'Pattern (strcat "(" init ")"))
    (foreach obj (mapcar 'car obj_list)
    (setq oldtxt (vla-get-textstring obj))
    (setq newvalue (+ numadd (atoi init)))
    (setq newtxt (itoa newvalue))
    (while (< (strlen newtxt) maxlen)
      (setq newtxt (strcat "0" newtxt))
      )
      (if (not (eq "0" (substr newtxt 1 1)))
   (setq newtxt (strcat "0" newtxt)))
           (princ (strcat "\n" init " ==> " newtxt));for debug only
    (setq result
    (vlax-invoke-method regex 'Execute oldtxt)
   )
    (if (> (vlax-get-property result 'Count) 0)
      (progn
 (setq newstr
        (vlax-invoke-method regex 'Replace oldtxt newtxt)
       )
 (vla-put-textstring obj newstr)
 ))
    (vlax-release-object result)
    )
(setq match_list (vl-remove-if
  (function (lambda (x)
       (member x obj_list)))
       match_list)
   )
         (setq init (1+ (atoi init))
   init (itoa init)
   )
    (while (< (strlen init) maxlen)
      (setq init (strcat "0" init))
      )
  )
    (vlax-release-object regex)
    )
  )
    )
 )
(*error* nil)
(princ)
)
(vl-load-com)
(princ "\n***   Type RNZERO to renumbering stations   ***")
(prin1)

(cond
((= DrawingID 021)
 (setq DrawingName "text_021_text.dxf"))
((= DrawingID 022)
 (setq DrawingName "text_022_text.dxf"))
((= DrawingID 023)
 (setq DrawingName "text_023_text.dxf"))
)

(setq DrawingName (strcat "text_" (itoa DrawingID) "_text.dxf"))

(ssget "X" '((0 . "MTEXT") (1 . "*201*")))