home *** CD-ROM | disk | FTP | other *** search
/ Share Gallery 1 / share_gal_1.zip / share_gal_1 / GR / GR505.ZIP / LSP.EXE / CHGJUST.LSP < prev    next >
Lisp/Scheme  |  1989-01-03  |  3KB  |  99 lines
  1. ; CHGJUST.LSP 
  2. ; Change the justification of text entities.
  3. ; Part of the Text Utilities 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 "\nCHGJUST.LSP - (c)1989 Alacrity\n")
  16.  
  17. ;-----------------------
  18. ; Filter Selection Sets
  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:CHGJUST (/ ss elist ename num just key find repl old getjust)
  42.   ;-------------------
  43.   ; Get Justification
  44.   ;-------------------
  45.   (defun getjust (key)
  46.     (length (member key '("Fit" "Middle" "Align" "Right" "Center")))
  47.   )
  48.   ;----------------------
  49.   ; Select TEXT Entities
  50.   ;----------------------
  51.   (cond
  52.     ((setq ss (ssget)) (ssfilter ss '(0 . "TEXT") nil))
  53.     (T
  54.       (princ "\nSelecting all TEXT in drawing...")
  55.       (setq ss (ssget "X" '((0 . "TEXT"))))
  56.     )
  57.   )
  58.   (princ (strcat "\n" (itoa (sslength ss)) " TEXT entities selected."))
  59.   ;----------------
  60.   ; The Main Stuff
  61.   ;----------------
  62.   (if ss
  63.     (progn
  64.       (initget "All Left Right Center Middle Align Fit")
  65.       (setq key (getkword "\nMATCH Left/Right/Center/Middle/Align/Fit/<All>: "))
  66.       (cond
  67.         (key (setq find (getjust key)))
  68.         (T (setq find 0))
  69.       )
  70.       (initget 1 "Left Right Center Middle")
  71.       (setq key (getkword "\nCHANGE Left/Right/Center/Middle: "))
  72.       (setq repl (getjust key)
  73.             num 0
  74.             i -1
  75.       )
  76.       (while (setq ename (ssname ss (setq i (1+ i))))
  77.         (setq elist (entget ename)
  78.               old (cdr (assoc 72 elist))
  79.         )
  80.         (if (or (zerop find) (= find old))
  81.           (progn
  82.             (if (member old '(0 3 5))
  83.               (setq a 11 b 10)
  84.               (setq a 10 b 11)
  85.             )
  86.             (setq elist (subst (cons a (cdr (assoc b elist))) (assoc a elist) elist))
  87.             (entmod (subst (cons 72 repl) (cons 72 old) elist))
  88.             (setq num (1+ num))
  89.           )
  90.         )
  91.       )
  92.     )
  93.   )
  94.   (princ (strcat "\n" (itoa num) " lines changed."))
  95.   (princ)
  96. )
  97.  
  98. ; End Of File
  99.