home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p190 / 4.ddi / LSP / HJ98.LSP < prev   
Encoding:
Text File  |  1990-05-14  |  5.0 KB  |  152 lines
  1. ;
  2. ;   To write text
  3. ;
  4. (defun hj01 ()
  5.  (setvar "cmdecho" 0)
  6.  (setq q2s "5" n1s "10" qs "2")
  7.  (setq ts (getvar "textstyle"))
  8.  (if (/= ts "HZ")
  9.  (progn (initget "y n")
  10.         (menucmd "s=ds14")
  11.         (setq h (getkword "\n╩Θ╨┤╓╨╬─┬≡<Y/N>?"))
  12.         (if (= h "y")
  13.          (progn (princ "\n╔Φ╫╓╨═╬¬║║╫╓╫╓╨═")
  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 j (getstring "\n╩Σ─π╥¬╩Θ╨┤╡─╬─▒╛:"))
  23.  (setq js j a "")
  24.  (while (= a "")
  25.  (if (> (fix (+ (/ (strlen j) 2.0) 0.6)) (fix (/ (strlen j) 2.0)))
  26.     (setq j (strcat j " "))
  27.  )
  28.  (command "graphscr")
  29.  (setq q2 (getdist (strcat "\n╩Σ╚δ╫╓╕▀<" q2s ">:")))
  30.  (if (= q2 nil) (setq q2 (atof q2s)) (setq q2s (rtos q2 2 2)))
  31.  (setq n1 (getint (strcat "\n╩Σ╚δ├┐╨╨╩Θ╨┤╫╓╩²<" n1s ">:")))
  32.  (if (= n1 nil) (setq n1 (atoi n1s)) (setq n1s (rtos n1 2 0)))
  33.  (if (= (getvar "textstyle") "HZ") (setq n1 (* n1 2)))
  34.  (setq q (getdist (strcat "\n╩Σ╚δ╨╨╝Σ╛α<" qs ">:")))
  35.  (if (= q nil) (setq q (atof qs)) (setq qs (rtos q 2 2)))
  36.  (initget "l r C A")
  37.  (menucmd "s=ds29")
  38.  (setq h (getkword "\n╤í╘±╩Θ╨┤╖╜╩╜ <L / R / C / A>:"))
  39.  (cond ((= h "l") (setq pt (getpoint "\n╞≡╩╝╡π: ")) (hj03 0 pt 0))
  40.        ((= h "C") (setq pt (getpoint "\n╓╨╨─╡π: ")) (hj03 "c" pt 0))
  41.        ((= h "r") (setq pt (getpoint "\n╓╒╡π: ")) (hj03 "r" pt 0))
  42.        ((= h "A") (setq pt (getpoint "\n╡┌╥╗╡π: ")) (setq pt1 (getpoint "\n╡┌╢■╡π: ")) (hj03 "a" pt pt1))
  43.  )
  44.  (menucmd "s=ds22a")
  45.  (menucmd "s=ds14")
  46.  (initget "y n")
  47.  (setq a (getstring "\n╨▐╕─╕├┤╩╫Θ┬≡<Y/N>?"))
  48.  (if (= a "y") (hj02))
  49.  (menucmd "s=ds22a")
  50.  (setq a (getstring "\n<Enter>╝╠╨°,<E>╜ß╩°:"))
  51.  (cond ((= a "") 
  52.     (setq j (getstring (strcat "\n╩Σ╚δ╥¬╩Θ╨┤╡─╬─▒╛╫╓╖√<" js ">:")))
  53.          (if (= j "") (setq j js) (setq js j)))
  54.        (T 1)
  55.   )
  56.  )
  57. (menucmd "s=screen")
  58. (setq js nil n3 nil j1 nil n1 nil q1 nil q2 nil)
  59. (setq q2s nil n1s nil qs nil a1 nil)
  60. (print "END!")
  61. )
  62. (defun hj03 (q1 pt11 pt22)
  63.  (setq n3 1 n (strlen j))
  64.  (setq j1 (substr j n3 n1))
  65.  (setq pt pt11 pt1 pt22 y nil)
  66.  (if (/= q1 "a") (progn
  67.  (setq a0 (getangle "\n╬─▒╛╩Θ╨┤╜╟╢╚<0>:"))
  68.  (if (= a0 nil) (setq a0 0))
  69.  ))
  70.  (IF (< N1 N)
  71.  (PROGN
  72.  (while (> (- n n3) n1)
  73.   (cond ((= q1 0) (command "text" pt q2 (angtos a0 0 1) j1))
  74.        ((= q1 "c") (command "text" "c" pt q2 (angtos a0 0 1) j1))
  75.        ((= q1 "r") (command "text" q1 pt q2 (angtos a0 0 1) j1))
  76.       ((= q1 "a") (command "text" q1 pt pt1 j1)
  77.                   (setq q2 (cdr (assoc 40 (entget (entlast)))))
  78.                   (setq a1(cdr (assoc 50 (entget (entlast)))))
  79.                   (setq pt1 (polar pt1 (- a1 (/ pi 2)) (+ q2 q))))
  80.   )
  81.   (if (= q1 "a")
  82.   (setq pt (polar pt (- a1 (/ pi 2)) (+ q2 q)))
  83.   (setq pt (polar pt (- a0 (/ pi 2)) (+ q2 q))))
  84.   (setq y (cons (entlast) y))
  85.   (setq n3 (+ n3 n1))
  86.   (setq j1 (substr j n3 n1))
  87.  )
  88. (setq e (entlast))
  89. (setq ab (cdr (assoc 41 (entget e))))
  90. (setq q2 (cdr (assoc 40 (entget e))))
  91. (setq q (cdr (assoc 50 (entget e))))
  92. (setq d (+ (* (/ n1 2) q2 ab 0.0433) (* (/ n1 2) q2 ab)))
  93. (cond ((= q1 "c") (setq pt (polar pt (+ a0 pi) (/ d 2))))
  94.       ((= q1 "r") (setq pt (polar pt (+ a0 pi) d)))
  95.       (T 1)
  96. )
  97. (command "text" pt q2 (* (/ q pi) 180) j1)
  98. )
  99. (PROGN
  100.   (cond ((= q1 0) (command "text" pt q2 (angtos a0 0 1) j1))
  101.        ((= q1 "c") (command "text" "c" pt q2 (angtos a0 0 1) j1))
  102.        ((= q1 "r") (command "text" q1 pt q2 (angtos a0 0 1) j1))
  103.       ((= q1 "a") (command "text" q1 pt pt1 j1))
  104.   )
  105. ))
  106. (setq y (cons (entlast) y))
  107. (setq ab nil n3 nil)
  108. )
  109. (Defun hj02 ( / g g1 b1 b)
  110.   (setq y (reverse y))
  111.   (setq h "y")
  112.   (while (= h "y")
  113.   (princ "\n╩Θ╨┤╡─╬─▒╛╩╟:")
  114.   (princ js)
  115.   (setq b (getint "\n╩Σ╚δ╫╓┤«╓╨╜½╨▐╕─╡─╞≡╩╝╫╓╬╗╩²:"))
  116.   (setq c (getstring t "\n╩Σ╚δ╥¬╨▐╕─╡─╫╓┤«,╗≥<D>╔╛╫╓,╗≥<I>▓σ╫╓:"))
  117.   (setq g (substr js 1 (* (1- b) 2)))
  118.   (setq b1 (strlen c))
  119.   (cond ((or (= c "d") (= c "D"))
  120.         (setq b2 (getint "\n╔╛╚Ñ╡─╫╓╩²<1>"))
  121.         (if (= b2 nil) (setq b2 1))
  122.         (setq g1 (substr js (+ (* 2 (+ (1- b) b2)) 1)))
  123.         (setq a3 (strcat g g1)))
  124.         ((or (= c "I") (= c "i"))
  125.          (setq c (getstring T "\n╩Σ▓σ╚δ╡─╫╓╖√┤«:"))
  126.          (setq g1 (substr js (+ (* 2 (1- b)) 1)))
  127.          (setq a3 (strcat g c g1)))
  128.          (T (setq g1 (substr js (+ b1 (* 2 (1- b)) 1)))
  129.           (setq a3 (strcat g c g1)))
  130.   )
  131.   (if (<= (* b 2) n1)
  132.    (setq k 0)
  133.    (setq k (1- (fix (/ (* b 2.0) n1)))))
  134.   (setq n (length y))
  135.   (while (< k n)
  136.   (setq el (assoc 1 (setq e (entget (nth k y)))))
  137.   (setq en (substr a3 (1+ (* k n1)) n1))
  138.   (if (= k (1- n)) (setq en (substr a3 (1+ (* k n1)))))
  139.   (setq e (subst (cons 1 en) el e))
  140.   (entmod e)
  141.   (setq k (1+ k))
  142.   )
  143.   (initget "y n")
  144.   (menucmd "s=ds14")
  145.   (setq h (getkword "\n╗╣╨▐╕─┬≡<Y/N>?:"))
  146.   (setq js a3)
  147.   )
  148. (setq a3 nil)
  149. )
  150. (princ "│╠╨≥╫░╚δ┴╦..")
  151. (princ)
  152.