home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p190 / 3.ddi / LSP / HJ95.LSP < prev    next >
Encoding:
Text File  |  1990-07-21  |  6.3 KB  |  194 lines
  1. ;
  2. ;   To write text from the item file
  3. ;
  4. (defun hj01 ()
  5.  (setvar "cmdecho" 0)
  6.  (setq ts (getvar "textstyle"))
  7.  (if (/= ts "HZ")
  8.  (progn (initget "y n")
  9.         (menucmd "s=ds14")
  10.         (setq h (getkword "\n╩Θ╨┤╓╨╬─┬≡<Y/N>?"))
  11.         (if (= h "y")
  12.          (progn (princ "\n╔Φ╫╓╨═╬¬║║╫╓╫╓╨═")
  13.                 (setvar "regenmode" 0)
  14.                 (setq b (getreal "\n╫╓╡─┐φ╕▀▒╚<1>:"))
  15.                 (if (= b nil) (setq b 1))
  16.                 (setq a (getangle "\n╫╓╡─╟π╨▒╜╟<0>:"))
  17.                 (if (= a nil) (setq a 0))
  18.                 (setq a (angtos a 0 1))
  19.                 (command "STYLE" "hz" "txt,hztxt" "" b a "" "")
  20.         ))
  21.  ))
  22.  (setq a 0)
  23.  (setq q2s "5" n1s "10" qs "2")
  24.  (menucmd "s=HYHZ")
  25.  (while (/= a "")   ;│╠╨≥╓≈╤¡╗╖
  26.   (setq m '())
  27.   (setq b1 "y")  ;╔Φ▓Θ╤»╓╨╢╧
  28.   (while (= b1 "y")
  29.   (setq a (getstring "\n╩Σ╚δ┤╩╫Θ└α╨═╗≥<Enter>╜ß╩°:"))
  30.   (if (/= a "") 
  31.   (progn
  32.    (setq b (strcat "txt\\hhj" a ".tat"))
  33.    (setq p (open b "r"))
  34.    (if (= p nil)
  35.     (princ "\n╬▐╕├└α╨═┤╩╫Θ┤µ╘┌,╓╪╨┬╤í╘±!")
  36.    (progn
  37.    (command "textscr")
  38.    (read-line p)
  39.    (setq k (read-line p) i 1)
  40.    (while (/= k nil)
  41.     (setq m (cons k m))
  42.     (princ (strcat "\n╡┌<" (itoa i) ">╫Θ   ")) (princ k)
  43.     (setq i (1+ i))
  44.     (cond ((= i 23) (setq h (getstring "\n╙├<Enter>╗╣╙╨,╗≥<E>═ú╓╣:")))
  45.           ((= i 46) (setq h (getstring "\n╙├<Enter>╗╣╙╨,╗≥<E>═ú╓╣:")))
  46.           ((= i 69) (setq h (getstring "\n╙├<Enter>╗╣╙╨,╗≥<E>═ú╓╣:")))
  47.           ((= i 92) (setq h (getstring "\n╙├<Enter>╗╣╙╨,╗≥<E>═ú╓╣:")))
  48.           ((= i 115) (setq h (getstring "\n╙├<Enter>╗╣╙╨,╗≥<E>═ú╓╣:")))
  49.           ((= i 138) (setq h (getstring "\n╙├<Enter>╗╣╙╨,╗≥<E>═ú╓╣:")))
  50.           ((= i 161) (setq h (getstring "\n╙├<Enter>╗╣╙╨,╗≥<E>═ú╓╣:")))
  51.           (T 1)
  52.     )
  53.     (if (or (= h "e") (= h "E")) (setq k nil)
  54.     (setq k (read-line p)))
  55.    )
  56.    (close p)
  57.    (initget "y n")
  58.    (setq b1 (getkword "\n╓╪╨┬▓Θ╤»┬≡<Y/N>?"))
  59.    (if (= b1 "n")
  60.    (progn
  61.    (setq m (reverse m)
  62.          s 1)
  63.    (while (/= s "")
  64.    (setq n (getint "\n╩Σ╚δ╜½╩Θ╨┤╡─┤╩╫Θ╞≡╩╝╨≥║┼: "))
  65.    (setq k (getstring T "\n╦│╨≥╩Σ╚δ╬─▒╛╡─┤╩╫Θ╨≥║┼ (╓╨╝Σ╕⌠┐╒╕±):"))
  66.    (setq k (read (strcat "(" k ")")))
  67.    (setq j (nth (1- n) m))
  68.    (if (> (fix (+ (/ (strlen j) 2.0) 0.6)) (fix (/ (strlen j) 2.0)))
  69.       (setq j (strcat j " "))
  70.     )
  71.     (setq n (length k) i 0)
  72.     (while (< i n)
  73.       (setq j (strcat j (nth (1- (nth i k)) m)))
  74.       (setq i (1+ i))
  75.       (if (> (fix (+ (/ (strlen j) 2.0) 0.6))
  76.              (fix (/ (strlen j) 2.0)))
  77.        (setq j (strcat j " "))
  78.       )
  79.     )
  80.     (princ "\n╜½╥¬╩Θ╨┤╡─╬─▒╛╩╟ :")
  81.     (princ "\n-------------") (princ (strcat "\n" j))
  82.     (princ "\n-------------")
  83.     (setq s (getstring "\n╙├<Enter>╚╖╚╧,╨▐╕─╬─▒╛─┌╚▌<C>╗≥╞Σ╦ⁿ╝ⁿ╓╪╩Σ:"))
  84.     (if (or (= s "c") (= s "C"))
  85.       (hj04))
  86.     )
  87.     (if (/= j nil)
  88.      (hj02 j))
  89.    (menucmd "s=HYHZ")
  90.    ))
  91.    ))
  92.    )
  93.    (setq b1 "n")   ;╜ß╩°╠⌡╝■
  94.    )
  95.    )
  96.  )
  97.  (menucmd "s=hz")
  98.  (setq s nil a1 nil j1 nil n1 nil n3 nil j1 nil q1 nil)
  99.  (setq q2 nil q2s nil n1 nil n1s nil qs nil)
  100.  (print "END!")
  101. )
  102. (defun hj02 (j)
  103.  (command "graphscr")
  104.  (setq q2 (getdist (strcat "\n╩Σ╚δ╫╓╕▀<" q2s ">:")))
  105.  (if (= q2 nil) (setq q2 (atof q2s)) (setq q2s (rtos q2 2 2)))
  106.  (setq n1 (getint (strcat "\n╩Σ╚δ├┐╨╨╩Θ╨┤╫╓╩²<" n1s ">:")))
  107.  (if (= n1 nil) (setq n1 (atoi n1s)) (setq n1s (rtos n1 2 0)))
  108.  (setq n1 (* n1 2))
  109.  (setq q (getdist (strcat "\n╩Σ╚δ╨╨╝Σ╛α<" qs ">:")))
  110.  (if (= q nil) (setq q (atof qs)) (setq qs (rtos q 2 2)))
  111.  (initget "l r C A")
  112.  (menucmd "s=ds29")
  113.  (setq h (getkword "\n╤í╘±╩Θ╨┤╖╜╩╜ <L / R / C / A>:"))
  114.  (cond ((= h "l") (setq pt (getpoint "\n╞≡╩╝╡π: ")) (hj03 0 pt 0))
  115.        ((= h "C") (setq pt (getpoint "\n╓╨╨─╡π: ")) (hj03 "c" pt 0))
  116.        ((= h "r") (setq pt (getpoint "\n╓╒╡π: ")) (hj03 "r" pt 0))
  117.        ((= h "A") (setq pt (getpoint "\n╡┌╥╗╡π: ")) (setq pt1 (getpoint "\n╡┌╢■╡π: ")) (hj03 "a" pt pt1))
  118.  )
  119.  )
  120. (defun hj03 (q1 pt11 pt22)
  121.  (setq n3 1 n (strlen j))
  122.  (setq j1 (substr j n3 n1))
  123.  (setq pt pt11 pt1 pt22)
  124.  (if (/= q1 "a") (progn
  125.  (setq a0 (getangle "\n╬─▒╛╩Θ╨┤╜╟╢╚<0>:"))
  126.  (if (= a0 nil) (setq a0 0))
  127.  ))
  128.  (IF (< N1 N)
  129.  (PROGN
  130.  (while (> (- n n3) n1)
  131.   (cond ((= q1 0) (command "text" pt q2 (angtos a0 0 1) j1))
  132.        ((= q1 "c") (command "text" "c" pt q2 (angtos a0 0 1) j1))
  133.        ((= q1 "r") (command "text" q1 pt q2 (angtos a0 0 1) j1))
  134.       ((= q1 "a") (command "text" q1 pt pt1 j1)
  135.                   (setq q2 (cdr (assoc 40 (entget (entlast)))))
  136.                   (setq a1(cdr (assoc 50 (entget (entlast)))))
  137.                   (setq pt1 (polar pt1 (- a1 (/ pi 2)) (+ q2 q))))
  138.   )
  139.   (if (= q1 "a")
  140.   (setq pt (polar pt (- a1 (/ pi 2)) (+ q2 q)))
  141.   (setq pt (polar pt (- a0 (/ pi 2)) (+ q2 q))))
  142.   (setq n3 (+ n3 n1))
  143.   (setq j1 (substr j n3 n1))
  144.  )
  145. (setq e (entlast))
  146. (setq ab (cdr (assoc 41 (entget e))))
  147. (setq q2 (cdr (assoc 40 (entget e))))
  148. (setq q (cdr (assoc 50 (entget e))))
  149. (setq d (+ (* (/ n1 2) q2 ab 0.0433) (* (/ n1 2) q2 ab)))
  150. (cond ((= q1 "c") (setq pt (polar pt (+ a0 pi) (/ d 2))))
  151.       ((= q1 "r") (setq pt (polar pt (+ a0 pi) d)))
  152.       (T 1)
  153. )
  154. (command "text" pt q2 (* (/ q pi) 180) j1)
  155.  )
  156.  (PROGN
  157.   (cond ((= q1 0) (command "text" pt q2 (angtos a0 0 1) j1))
  158.        ((= q1 "c") (command "text" "c" pt q2 (angtos a0 0 1) j1))
  159.        ((= q1 "r") (command "text" q1 pt q2 (angtos a0 0 1) j1))
  160.       ((= q1 "a") (command "text" q1 pt pt1 j1))
  161.    )
  162.  ))
  163. (setq ab nil n3 nil a0 nil)
  164. )
  165. (Defun hj04 ( / g g1 b1 b)
  166.   (setq h "y")
  167.   (while (= h "y")
  168.   (setq b (getint "\n╩Σ╚δ╫╓┤«╓╨╜½╨▐╕─╡─╞≡╩╝╫╓╬╗╩²:"))
  169.   (setq c (getstring t "\n╩Σ╚δ╥¬╨▐╕─╡─╫╓┤«,╗≥<D>╔╛╫╓,╗≥<I>▓σ╫╓:"))
  170.   (setq g (substr j 1 (* (1- b) 2)))
  171.   (setq b1 (strlen c))
  172.   (cond ((or (= c "d") (= c "D"))
  173.         (setq b2 (getint "\n╔╛╚Ñ╡─╫╓╩²<1>"))
  174.         (if (= b2 nil) (setq b2 1))
  175.         (setq g1 (substr j (+ (* 2 (+ (1- b) b2)) 1)))
  176.         (setq j (strcat g g1)))
  177.         ((or (= c "I") (= c "i"))
  178.          (setq c (getstring T "\n╩Σ▓σ╚δ╡─╫╓╖√┤«:"))
  179.          (setq g1 (substr j (+ (* 2 (1- b)) 1)))
  180.          (setq j (strcat g c g1)))
  181.          (T (setq g1 (substr j (+ b1 (* 2 (1- b)) 1)))
  182.           (setq j (strcat g c g1)))
  183.   )
  184.   (princ "\n----------╨▐╕─║≤╡─╬─▒╛:----------")
  185.   (princ (strcat "\n" j))
  186.   (initget "y n")
  187.   (menucmd "s=ds14")
  188.   (setq h (getkword "\n╗╣╨▐╕─┬≡<Y/N>?:"))
  189.   )
  190. (setq s "" b2 nil)
  191. )
  192. (princ "│╠╨≥╫░╚δ┴╦..")
  193. (princ)
  194.