home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p190 / 3.ddi / LSP / HJ153.LSP < prev    next >
Encoding:
Text File  |  1990-03-19  |  3.9 KB  |  139 lines
  1. ;
  2. ;   to dim any object
  3. ;
  4. (Defun hj01 ()
  5. (princ "\n│▀┤τ╧▀▓╬╩²╬¬╙├╗º╫╘╨╨╔Φ╢¿")
  6. (grtext -1 "\n│▀┤τ╧▀▓╬╩²╬¬╙├╗º╫╘╨╨╔Φ╢¿")
  7.   (setvar "cmdecho" 0)
  8.   (setvar "blipmode" 0)
  9.   (command "layer" "s" "chi" "")
  10.   (setq p 1 qs "3" as "0")
  11.   (while (= p 1)
  12.   (menucmd "s=ds1b")
  13.   (setq a0 (getangle (strcat "\n╩Σ╚δ│▀┤τ╧▀╡─╖╜╧≥╜╟<" as ">:")))
  14.   (if (= a0 nil) (setq a0 (/ (* (read as) pi) 180))
  15.    (setq as (angtos a0 0 0))
  16.   )
  17.   (setq e 1)
  18.   (while (= e 1)
  19.   (princ "\n╫ó╥Γ! ╩Σ╚δ╕±╩╜--╩²─┐X╛α└δ m x d ,╓╨╝Σ╥╘╢║║┼╕⌠┐¬.╡▒m=1╩▒┐╔╓▒╜╙╩Σ╛α└δ")
  20.   (grtext -1 " ╫ó╥Γ! ╩Σ╚δ╕±╩╜,└α═¼╓ß═°╩Σ╚δ╕±╩╜")
  21.   (menucmd "s=ds28")
  22.   (setq zm (strcat (getstring "\n╦│╨≥╩Σ╚δ╕≈│▀┤τ╡─╛α└δ: ") "."))
  23.   (princ "\n│▀┤τ╛α└δ:") (princ zm)
  24.   (menucmd "s=dx")
  25.   (menucmd "s=ds15")
  26.   (setq e (getstring "\n╙├<Enter>╚╖╚╧╗≥╞Σ╦ⁿ╝ⁿ╓╪╩Σ:"))
  27.   (if (/= e "") (setq e 1))
  28.   )
  29.   (hj02 zm) (setq zm (strcat "(" ns ")"))
  30.   (hj05)
  31.   (hj03 zm) (setq l (reverse nl) zm nil)
  32.   (initget 1)
  33.   (setq pt0 (getpoint "\n╟δ╡π│÷╜½╥¬▒Ω╫ó╡─│▀┤τ╞≡╡π:"))
  34.   (if (or (= (getvar "dimse1") 0) (= (getvar "dimse2") 0))
  35.   (progn
  36.   (initget 1)
  37.   (setq a1 (getangle pt0 "\n╚╖╢¿│▀┤τ╧▀╤╙╔∞╧▀╖╜╧≥:"))
  38.   )
  39.   (setq a1 (+ a0 (/ pi 2)))
  40.   )
  41.   (setq q (getstring (strcat "\n╩Σ│▀┤τ╧▀╛α─┐▒Ω╛α└δ<" qs ">:")))
  42.   (if (= q "") (setq q qs) (setq qs q))
  43.   (setq q (atof q))
  44.   (setq dm (apply '+ l))
  45.   (cond ((< (abs (- a0 pi)) 0.02)
  46.          (setq l (reverse l) pt0 (polar pt0 a0 dm))
  47.          (setq a0 0))
  48.         ((or (< (abs (- a0 (* 3 (/ pi 2)))) 0.02)
  49.              (< (abs (+ a0 (/ pi 2))) 0.02))
  50.          (setq l (reverse l) pt0 (polar pt0 a0 dm))
  51.          (setq a0 (/ pi 2)))
  52.         (T 1)
  53.   )
  54.   (if (> a1 pi) (setq a1 (- a1 (* 2 pi))))
  55.   (cond ((and (< (- a0 a1) 0) (> (- a0 a1) (- 0 pi)))
  56.          (setq a1 (+ a0 (/ pi 2))))
  57.         (T (setq a1 (- a0 (/ pi 2))))
  58.   )
  59.   (setq n (length l) i 0)
  60.   (setq pt1 pt0)
  61.   (while (< i n)
  62.     (setq d (nth i l))
  63.     (setq pt2 (polar pt1 a0 d))
  64.     (setq pt (polar pt1 a1 q))
  65.     (command "dim" "rotate" (angtos a0 0 1) pt1 pt2
  66.                             pt (rtos (* d sc) 2 0) ^c)
  67.     (if (= i 0) (setq pt3 (polar pt (+ a0 pi) 2)))
  68.     (setq pt1 pt2)
  69.     (if (= i (1- n)) (setq pt4 (polar pt a0 (+ 2 (/ d sc)))))
  70.     (setq i (1+ i))
  71.   )
  72.   (command "LINE" pt3 pt4 "")
  73.   (initget "e")
  74.   (menucmd "s=ds22a")
  75.   (setq p (getkword "╙├<Enter>╝╠╨°,<E>╜ß╩°."))
  76.   (if (= p nil) (setq p 1))
  77.   )
  78. (setq ns nil nl nil)
  79. (menucmd "s=screen")
  80. (grtext)
  81. (print "END!")
  82. )
  83. (defun hj02 (s)
  84.   (setq n (strlen s))
  85.   (setq k 2) (setq ns (substr s 1 1))
  86.   (setq b 0 c 0)
  87.   (while (<= k n)
  88.     (setq a (substr s k 1))
  89.     (if (and (= a ",") (= k (1- n))) (setq c 1) (setq c 0))
  90.     (cond ((or (= a "*") (= a "X") (= a "x")) (setq a " ") (setq b 1))
  91.           ((= a ",") (if (= b 1) (setq a " ") (setq a " 1 "))
  92.                      (setq b 0))
  93.           (T 1)
  94.     )
  95.     (setq k (1+ k))
  96.    (cond
  97.        ((and (= a ".") (/= b 1)) (setq ns (strcat ns " 1")))
  98.        ((and (/= c 1) (/= a ".")) (setq ns (strcat ns a)))
  99.        (T 1)
  100.   )
  101.   )
  102. )
  103. (defun hj03 (l)
  104.   (setq n (length l))
  105.   (setq n (/ n 2))
  106.   (setq k 1 nl nil)
  107.   (while (<= k n)
  108.   (setq a (car l))
  109.   (setq b (cadr l))
  110.   (cond ((= a 1) (setq nl (cons b nl)))
  111.         ((= b 1) (setq nl (cons a nl)))
  112.         (T  (repeat a (setq  nl (cons b nl))))
  113.   )
  114.   (setq l (cdr (cdr l)))
  115.   (setq k (1+ k))
  116.   )
  117. )
  118. (Defun hj05 ()
  119.   (setq n (strlen zm))
  120.   (setq l nil k 3 a (substr zm 2 1))
  121.   (while (<= k n)
  122.     (setq q (substr zm k 1))
  123.     (if (or (= q " ") (= q ")"))
  124.        (progn (setq a (atof a))
  125.               (if (> a 30) (setq a (/ a sc)) 
  126.                   (progn (setq a (rtos a 2 0))
  127.                          (setq a (atoi a))
  128.                   )
  129.               )
  130.               (setq l (cons a l))
  131.               (setq a (substr zm (1+ k) 1) k (1+ k))
  132.        )
  133.         (setq a (strcat a q))
  134.      )
  135.   (setq k (1+ k))
  136.   )
  137.   (setq zm (reverse l))
  138. )
  139.