home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p190 / 4.ddi / LSP / HJ97.LSP < prev    next >
Encoding:
Text File  |  1990-05-14  |  2.0 KB  |  70 lines
  1. ;
  2. ;  Correct the text
  3. ;
  4. (Defun hj01 ()
  5.  (setvar "cmdecho" 0)
  6.  (setvar "blipmode" 0)
  7.  (setq h "y")
  8.  (while (= h "y")
  9.   (princ "\n╤í╚í╥¬╨▐╕─╡─╬─▒╛╫╓┤«")
  10.   (grtext -1 "  ╤í╚í╥¬╨▐╕─╡─╬─▒╛╫╓┤«" 1)
  11.   (setq p (ssget))
  12.   (if (/= p nil)
  13.   (progn
  14.   (setq n (sslength p)) (setq y nil k 0 y1 nil)
  15.   (while (< k n)
  16.     (setq y (cons (ssname p k) y))
  17.     (setq y1 (cons (cdr (assoc 1 (entget (car y)))) y1))
  18.     (setq k (1+ k))
  19.   )
  20.   (prompt (strcat "\n╣▓╤í╘±┴╦" (itoa n) "╨╨╬─▒╛╨▐╕─."))
  21.   (setq js "")
  22.   (if (= n 1) (progn
  23.     (setq js (cdr (assoc 1 (entget (ssname p 0)))))
  24.     (setq n1 (strlen js)))
  25.     (progn (setq n1 (strlen (cdr (assoc 1 (entget (ssname p 1))))))
  26.            (setq js (apply 'strcat y1))
  27.    ))
  28.   (princ "\n╜½╨▐╕─╡─╬─▒╛╩╟: ")
  29.   (princ js)
  30.   (setq b (getint "\n╩Σ╚δ╫╓┤«╓╨╜½╨▐╕─╡─╞≡╩╝╫╓╬╗╩²:"))
  31.   (setq c (getstring t "\n╩Σ╚δ╥¬╨▐╕─╡─╫╓┤«,╗≥<D>╔╛╫╓,╗≥<I>▓σ╫╓:"))
  32.   (setq g (substr js 1 (* (1- b) 2)))
  33.   (setq b1 (strlen c))
  34.   (cond ((or (= c "d") (= c "D"))
  35.         (setq b2 (getint "\n╔╛╚Ñ╡─╫╓╩²<1>"))
  36.         (if (= b2 nil) (setq b2 1))
  37.         (setq g1 (substr js (+ (* 2 (+ (1- b) b2)) 1)))
  38.         (setq js (strcat g g1)))
  39.         ((or (= c "I") (= c "i"))
  40.          (setq c (getstring T "\n╩Σ▓σ╚δ╡─╫╓╖√┤«:"))
  41.          (setq g1 (substr js (+ (* 2 (1- b)) 1)))
  42.          (setq js (strcat g c g1)))
  43.          (T (setq g1 (substr js (+ b1 (* 2 (1- b)) 1)))
  44.           (setq js (strcat g c g1)))
  45.   )
  46.   (if (or (<= (* 2 b) n1) (= n 1))
  47.    (setq k 0)
  48.    (setq k (1- (fix (/ (* b 2.0) n1)))))
  49.   (setq n (length y))
  50.   (while (< k n)
  51.   (setq el (assoc 1 (setq e (entget (nth k y)))))
  52.   (setq en (substr js (1+ (* k n1)) n1))
  53.   (if (= k (1- n)) (setq en (substr js (1+ (* k n1)))))
  54.   (setq e (subst (cons 1 en) el e))
  55.   (entmod e)
  56.   (setq k (1+ k))
  57.   )
  58.   ))
  59.   (initget "y n")
  60.   (menucmd "s=ds14")
  61.   (setq h (getkword "\n╗╣╨▐╕─┬≡<Y/N>?:"))
  62.   )
  63. (setq y nil y1 nil en nil el nil js nil g1 nil b1 nil)
  64. (grtext)
  65. (menucmd "s=screen")
  66. (print "END!")
  67. )
  68. (princ "│╠╨≥╫░╚δ┴╦..")
  69. (princ)
  70.