home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-387-Vol-3of3.iso / f / feb93.zip / TIP840.LSP < prev    next >
Text File  |  1993-01-14  |  1KB  |  45 lines
  1. ;TIP840: CHTXJUST.LSP (C)1993, WILLIAM JONES
  2.  
  3. (DEFUN C:CHTXJUST (); CHANGE TEXT JUSTIFICATION
  4.  (SETVAR "CMDECHO" 0)
  5.  (SETQ AB (GETVAR "ANGBASE")
  6.   AD (GETVAR "ANGDIR")
  7.   AUN (GETVAR "AUNITS")
  8.   AUP (GETVAR "AUPREC"))
  9.  (SETVAR "ANGBASE" 0)
  10.  (SETVAR "ANGDIR" 0)
  11.  (SETVAR "AUNITS" 3)
  12.  (SETVAR "AUPREC" 8)
  13.  (SETQ INDEX 0 OL (GETVAR "CLAYER"))
  14.  (PROMPT "\nSELECT TEXT TO CHANGE JUSTIFICATION")
  15.  (SETQ G1 (SSGET)
  16.   SG1 (SSLENGTH G1))
  17.  (INITGET "L C R BL BC BR ML MC MR TL TC TR")
  18.  (SETQ TXJ (GETKWORD "SELECT JUSTIFICATION - [L C R BL BC BR ML MC MR TL TC TR]: "))
  19.  (REPEAT SG1
  20.   (SETQ E (SSNAME G1 INDEX)
  21.    ED (ENTGET E)
  22.    ET (CDR (ASSOC 0 ED)))
  23.   (IF (= ET "TEXT")
  24.    (PROGN
  25.     (SETQ EL (CDR (ASSOC 8 ED))
  26.      EI (CDR (ASSOC 10 ED))
  27.      EH (CDR (ASSOC 40 ED))
  28.      EA (CDR (ASSOC 50 ED))
  29.      TS (CDR (ASSOC 1 ED)))
  30.     (COMMAND "ERASE" E "")
  31.     (COMMAND "LAYER" "S" EL "")
  32.     (IF (= TXJ "L")
  33.      (COMMAND "TEXT" EI EH EA TS)
  34.      (PROGN
  35.       (COMMAND "TEXT" "J" TXJ EI EH EA TS)
  36.       (COMMAND "MOVE" (ENTLAST) "" (CDR (ASSOC 10 (ENTGET (ENTLAST)))) EI )))))
  37.   (SETQ INDEX (+ INDEX 1)))
  38.  (COMMAND "LAYER" "S" OL "")
  39.  (SETVAR "CMDECHO" 1)
  40.  (SETVAR "ANGBASE" AB)
  41.  (SETVAR "ANGDIR" AD)
  42.  (SETVAR "AUNITS" AUN)
  43.  (SETVAR "AUPREC" AUP)
  44.  (PRINC))
  45.