home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p047 / 4.ddi / PM / DMCB.LSP < prev    next >
Encoding:
Text File  |  1990-08-08  |  4.7 KB  |  143 lines
  1. ;****** PM\DMCB.LSP ****** 11-4-89 BJ
  2. (if (null tb) (setq tb0 100 tb 1.0 mmm "MM"))
  3. ; (if (/= (getvar "textstyle") "HZTEXT2")
  4. ;    (command "style" "" "txt,hztxt" "" 1.0 "" "" "" ""))
  5. (command "style" "" "" 0.0 1.0 "" "" "")
  6. ;********** C:DMCB **********
  7. (defun C:DMCB (/ wcy)
  8.   (rgcf1)
  9.   (setq wcy 1)
  10.   (rll11 nlll)
  11.   (while wcy
  12.   (setq mode (getstring "\n Rsj/DwgMCB
  13.       <or RETURN for none>:"))
  14.     (if (= mode "") (setq wcy nil)
  15.       (if mode (setq mode (strcase (substr mode 1 1)))))
  16.     (if (= mode "R") (rll12))
  17.     (if (= mode "D") (progn (dwgmcb ) (rll11 nlll)))
  18.   )
  19. )
  20. ;------------
  21. (defun rgcf1 ( )
  22.   (setq fn1 (strcat (getvar "dwgname") ".gcl"))
  23.   (setq f1 (open fn1 "r"))
  24.      (if (= f1 nil) (setq lll (list (list "tb0" tb0 tb mmm)))
  25.        (progn (setq lll (read (read-line f1))) (close f1))
  26.      )
  27.   (setq nlll lll)
  28. )
  29. (defun rll12 ( )
  30.   (setq ll01 (getstring (strcat 
  31.     "\n " ll11 " enter ll01:")))
  32.     (if (= ll01 "") (setq ll01 "tb"))
  33.   (setq ll12 (assoc ll01 nlll))
  34.   (print ll12)
  35.   (setq ll02 (cdr ll12))
  36. )
  37. (defun rll11 (nlll)
  38.   (setq wxr (length nlll) k 0 ll11 "*")
  39.   (while (< k wxr)
  40.     (setq ll01 (car (nth k nlll)))
  41.     (setq ll11 (strcat ll01 "/" ll11))
  42.     (setq k (1+ k))
  43.   )
  44. )
  45. ;------------
  46. (defun dwgmcb ( )
  47. (setq ll01 (strcase (getstring (strcat ll11 "\n Select <A-MCB>:"))))
  48.   (if (= ll01 "") (setq ll01 "A-MCB"))
  49.   (setq ll12 (assoc ll01 nlll))
  50.   (if ll12 (dmcb0))
  51. )
  52. (defun dmcb0 ( )
  53.   (pah) (setq ptx (car pt) pty (cadr pt)) (setq k -1)
  54.   (command "text" (list ptx (+ pty (* 1.0 zh))) (* 1.5 zh) 0.0
  55.     "    *** ├┼ ┤░ ▒φ *** ")
  56.   (setq e (entget (ssname (ssget "l") 0)))
  57.   (entmod (subst (cons 41 2.5) (assoc 41 e) e))
  58.   (command "text" (list ptx (+ pty (* -3.5 zh)))
  59.     (* 1.5 zh) 0.0 " ├┼┤░┤·║┼ ├┼ ┤░ ├√ │╞")
  60.   (setq pts (list (+ ptx (* 22.0 zh)) (+ pty (* -2.0 zh))))
  61.   (command "text" pts zh 0.0  "╢┤┐┌│▀┤τ <╡Ñ╬╗:mm>")
  62.   (setq pts (list (+ ptx (* 22.0 zh)) (+ pty (* -4.0 zh))))
  63.   (command "text" pts zh 0.0  "  ┐φ x ╕▀  ")
  64.       ;----------
  65.   (if (= (substr ll01 1 1) "A") (dsss01) (progn
  66.     (setq kk 1) (setq sss (cdr ll12))
  67.     (setq pts (list (+ ptx (* 34.5 zh))
  68.       (+ pty (* -3.5 zh))))
  69.     (command "text" "f" pts (polar pts 0.0 (* 8 zh))
  70.       (* 1.5 zh) "╩²┴┐<╡Ñ╬╗:╕÷>"))
  71.   )
  72.     ;---------
  73.   (command "text" (list (+ ptx (* 41.0 zh) (* kk 4.0 zh))
  74.     (+ pty (* -3.5 zh))) (* 1.5 zh) 0.0 "▓╔╙├═╝╝»")
  75.   (command "text" (list (+ ptx (* 49.0 zh) (* kk 4.0 zh))
  76.     (+ pty (* -3.5 zh))) (* 1.5 zh) 0.0
  77.     "═╝╝»╓╨┤·║┼    ▒╕   ╫ó")
  78. ;   "▓╔╙├═╝╝» ═╝╝»╓╨┤·║┼   ▒╕   ╫ó")
  79.   (setq pts (list (+ ptx (* 75 zh) (* kk 4.0 zh))
  80.     (+ pty (* (length sss) -2.0 zh) (* -8.5 zh))))
  81.   (command "pline" pt (list (car pts) (cadr pt))
  82.     pts (list (car pt) (cadr pts)) "c")
  83.   (command "line" (list (+ ptx (* 8.5 zh)) (cadr pts))
  84.     (list (+ ptx (* 8.5 zh)) pty) "")
  85.   (command "array" "l" "" "r" 1 3 (* 12.5 zh))
  86.   (command "line" (list (+ (car pts) (* -17.5 zh)) (cadr pts))
  87.     (list (+ (car pts) (* -17.5 zh)) pty) "")
  88.   (command "array" "l" "" "r" 1 3 (* -9.0 zh))
  89.   (setq pts (polar pt (* -0.5 pi) (* 4.5 zh)))
  90.   (command "line" pts (polar pts 0.0 (* (+ 75.0 (* kk 4.0)) zh)) "")
  91.   (command "array" "l" "" "r" (+ (length sss) 2) 1 (* -2.0 zh))
  92.      ;--------
  93.   (while k
  94.     (setq k (1+ k))
  95.     (setq s12 (nth k sss))
  96.     (if (= s12 nil) (setq k nil) (dsss02))
  97.   )
  98. )
  99. (defun dsss01 ( / s sn)
  100.   (setq ll02 (cdr ll12) ccc (car ll02) sss (cdr ll02))
  101.   (setq kk 0 nn (length ccc))
  102.   (while (< kk nn)
  103.     (setq pts (list (+ ptx (* 37.0 zh) (* kk 4.0 zh))
  104.       (+ pty (* -4.0 zh))))
  105.     (setq s (nth kk ccc) sn (strlen s))
  106.     (if (= (substr s 1 1) "B")
  107.       (setq s (strcat "▒Ω▓π" "X" (substr s 5)))
  108.       (setq s (strcat (substr s 1 (- sn 3)) "▓π")))
  109.     (command "text" "c" pts zh 0.0 s)
  110.     (setq kk (1+ kk))
  111.   )
  112.   (setq pts (list (+ ptx (* 37.0 zh) (* kk 4.0 zh))
  113.     (+ pty (* -4.0 zh))))
  114.   (command "text" "c" pts zh 0.0 "╨í╝╞")
  115.   (setq pts (list (+ ptx (* 37.0 zh) (* kk 2.0 zh))
  116.     (+ pty (* -2.0 zh))))
  117.   (command "text" "c" pts zh 0.0  "╩²   ┴┐ <╡Ñ╬╗:╕÷>")
  118. )
  119. (defun dsss02 ( / kk nn)
  120.   (setq kk 0 nn (length s12))
  121.   (while (< kk nn)
  122.     (setq pts (list (+ ptx (* 33.0 zh) (* kk 4.0 zh))
  123.       (+ pty (* -6.0 zh) (* -2.0 k zh))))
  124.     (if (= kk 0)
  125.       (command "text" "c" (list (+ ptx (* 4.0 zh))
  126.         (cadr pts)) zh 0.0 (car s12))
  127.       (command "text" "c" pts zh 0.0 (rtos (nth kk s12) 2 0)))
  128.     (setq kk (1+ kk))
  129.   )
  130. )
  131.     ;--------
  132. (defun pah ( )
  133.   (if (/= (getvar "clayer") "SJ") (command "layer" "m" "sj" ""))
  134.   (setq pt (getpoint "\n Start point:"))
  135.   (setq zh (getdist "\n Height <3.5>:" pt))
  136.     (if (null zh) (setq zh 3.5)) (setq zh (* tb 100 zh))
  137. )
  138. ;----------------------
  139. ;(defun C:CLEAN2 ( )
  140. ; (setq atomlist (member 'C:CLEAN2 atomlist))
  141. ; (princ)
  142. ;)
  143.