home *** CD-ROM | disk | FTP | other *** search
/ Share Gallery 1 / share_gal_1.zip / share_gal_1 / GR / GR505.ZIP / LSP.EXE / CHGTEXT.LSP < prev    next >
Lisp/Scheme  |  1989-01-03  |  3KB  |  111 lines
  1. ; CHGTEXT.LSP
  2. ; Find and replace string for text entities
  3. ; Part of the Text Utility Kit Version 1.0
  4. ; Copyright 1989 Alacrity
  5.  
  6. ; Alacrity
  7. ; 12405 SE 25th St
  8. ; Bellevue WA 98005
  9. ; Voice: (206)746-0680
  10. ; BBS: (206)643-5477
  11. ; CompuServe: 73417,1756
  12.  
  13. ; Shareware software, If you use -- Please don't abuse!
  14.  
  15. (princ "\nCHGTEXT.LSP - (c)1989 Alacrity\n")
  16.  
  17. ;----------------------
  18. ; Filter Selection Set
  19. ;----------------------
  20. (defun ssfilter (ss lst kill / len i group data match ename elist)
  21.   (princ "\nFiltering selection set...")
  22.   (setq i 0 group (car lst) data (cdr lst))
  23.   (while (ssname ss i)
  24.     (setq ename (ssname ss i) elist (entget ename)
  25.           match (== data (cdr (assoc group elist))))
  26.     (if (= kill match)
  27.       (ssdel ename ss)
  28.       (setq i (1+ i))
  29.     )
  30.   )
  31.   (if (ssname ss 0) ss nil)
  32. )
  33.  
  34. ;-------------
  35. ; Fuzzy Equal
  36. ;-------------
  37. (defun == (a b)
  38.   (if (member (type a) '(INT REAL)) (> 1.0E-6 (abs (- a b))) (= a b))
  39. )
  40.  
  41. (defun C:CHGTEXT (/ ss findstr find repl old new ename elist case
  42.                     len1 len2 len3 num i)
  43.   ;-------------
  44.   ; Find String
  45.   ;-------------
  46.   (defun findstr (old find repl case)
  47.     (setq len1 (strlen old) 
  48.           len2 (strlen find) 
  49.           len3 (strlen repl) 
  50.           i 1 
  51.           num 0
  52.     )
  53.     (while (<= i len1)
  54.       (if 
  55.         (if case
  56.           (equal (substr old i len2) find)
  57.           (equal (strcase (substr old i len2)) (strcase find))
  58.         )
  59.         (setq old (strcat (if (> i 1) (substr old 1 (1- i)) "") 
  60.               repl (substr old (+ i len2))) 
  61.               len1 (strlen old) 
  62.               i (+ i len3)
  63.         )
  64.         (setq i (1+ i))
  65.       )
  66.     )
  67.     old
  68.   )
  69.   ;-----------------------------
  70.   ; Get TEXT entities to change
  71.   ;-----------------------------
  72.   (cond
  73.     ((setq ss (ssget)) (ssfilter ss '(0 . "TEXT") nil))
  74.     (T
  75.       (princ "\nSelecting all TEXT in drawing.")
  76.       (setq ss (ssget "X" '((0 . "TEXT"))))
  77.     )
  78.   )
  79.   (princ (strcat "\n" (itoa (sslength ss)) " TEXT entities selected."))
  80.   ;------------------------------
  81.   ; Get FIND and REPLACE strings
  82.   ;------------------------------
  83.   (if ss
  84.     (progn
  85.       (initget 1)
  86.       (setq find (getstring T "\nSearch text: ")
  87.             repl (getstring T "\nReplace with: ")
  88.             i 0 num 0)
  89.       (initget "Yes No")
  90.       (setq case (if (= (getkword "\nCase sensitive? Yes/<No>: ") "Yes") T nil))
  91.       (while (setq ename (ssname ss i))
  92.         (setq elist (entget ename)
  93.               old (cdr (assoc 1 elist))
  94.               new (findstr old find repl case)
  95.               i (1+ i)
  96.         )
  97.         (if (/= old new)
  98.           (progn
  99.             (entmod (subst (cons 1 new) (cons 1 old) elist))
  100.             (setq num (1+ num))
  101.           )
  102.         )
  103.       )
  104.     )
  105.   )
  106.   (princ (strcat "\n" (itoa num) " lines changed."))
  107.   (princ)
  108. )
  109.  
  110. ; End Of File
  111.