home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p047 / 4.ddi / PM / EMCB.LSP < prev    next >
Encoding:
Text File  |  1990-08-08  |  4.2 KB  |  141 lines
  1. ;****** PM\EMCB.LSP ****** 11-24-89 BJ
  2. (if (null zh) (setq zh (* 350 tb)))
  3. ; (if (/= (getvar "textstyle") "HZTEXT2")
  4. ;    (command "style" "" "txt,hztxt" "" 1.0 "" "" "" ""))
  5. (command "style" "" "" 0.0 1.0 "" "" "")
  6. ;-----------
  7. (defun C:EMCB ( )
  8.   (if (null eee) (ppp0))
  9.   (setq wcy 1)
  10.   (while wcy
  11.     (setq mode (getint "\n 1.select:MCDH/2.editMCB/3.MCname/4.TJname
  12.       /5.cha-str <or RETRUN for none>:"))
  13.     (if (null mode) (setq wcy nil))
  14.     (if (= mode 1) (ppp0))
  15.     (if (= mode 2) (emcb0))
  16.     (if (= mode 3) (progn (setq wxr "MC") (insczh "mcname")))
  17.     (if (= mode 4) (progn (setq wxr "TJ") (insczh "mctjh")))
  18.     (if (= mode 5) (chastr))
  19.   )
  20. )
  21. ;------------
  22. (defun ppp0 ( )
  23.   (print "Select MCDH:")
  24.   (setq ppp (ssget))
  25.   (setq k 0 n (sslength ppp) eee nil)
  26.   (while (< k n)
  27.     (setq s1 (ssname ppp k) s10 (entget s1))
  28.     (if (= (cdr (assoc 0 s10)) "TEXT")
  29.       (setq eee (cons s1 eee)))
  30.     (setq k (1+ k))
  31.   )
  32. )
  33. ;------------
  34. (defun emcb0 ( )
  35.   (setq e2 (car (entsel "Select XM:")))
  36.   (if e2 (setq e20 (entget e2) p2x (car (cdr (assoc 10 e20)))))
  37.   (setq k 0 n (length eee))
  38.   (while (< k n)
  39.     (setq e1 (nth k eee) e10 (entget e1))
  40.     (redraw e1 3)
  41.     (if (= (substr (cdr (assoc 1 e20)) 1 5) " ├┼┤░") (emcb01))
  42.     (if (= (substr (cdr (assoc 1 e20)) 1 4) "╢┤┐┌") (emcb02))
  43.     (if (= (substr (cdr (assoc 1 e20)) 1 4) "▓╔╙├") (emcb03))
  44.     (if (= (substr (cdr (assoc 1 e20)) 1 4) "═╝╝»") (emcb04))
  45.     (redraw e1 4)
  46.     (setq k (1+ k))
  47.   )
  48. )
  49. ;------------
  50. (defun emcb01 ( )
  51.   (redraw e2 3)
  52.   (setq e (car (entsel "Select HZ-string:")))
  53.   (if e (setq e0 (entget e) e0 (cdr (assoc 1 e0))))
  54.   (if e0 (command "text" "c" (list (+ p2x (* 14.5 zh))
  55.     (cadr (cdr (assoc 10 e10)))) (cdr (assoc 40 e10)) 0.0 e0))
  56.   (redraw e2 4)
  57. )
  58. ;-----------
  59. (defun emcb02 ( )
  60.   (redraw e2 3)
  61.   (setq e10s (cdr (assoc 1 e10)))
  62.   (setq new (strcase (substr e10s 1 1)))
  63.   (if (or (= new "M") (= new "C")) (setq e10s (strcat
  64.     (substr e10s 2 2) "00X" (substr e10s 4 2) "00"))
  65.     (setq e10s "1200X1800"))
  66.   (setq new (getstring (strcat "enter DKCC<" e10s ">:")))
  67.   (if (/= new "") (setq e10s new))
  68.   (command "text" "c" (list (+ p2x (* 5.5 zh))
  69.     (cadr (cdr (assoc 10 e10)))) (cdr (assoc 40 e10)) 0.0 e10s)
  70.   (redraw e2 4)
  71. )
  72. ;------------
  73. (defun emcb03 ( )
  74.   (redraw e2 3)
  75.   (setq e (car (entsel "Select HZ-string:")))
  76.   (if e (setq e0 (entget e) e0 (cdr (assoc 1 e0))))
  77.   (if e0 (command "text" "c" (list (+ p2x (* 3.0 zh))
  78.     (cadr (cdr (assoc 10 e10)))) (cdr (assoc 40 e10)) 0.0 e0))
  79.   (redraw e2 4)
  80. )
  81. ;-----------
  82. (defun emcb04 ( )
  83.   (redraw e2 3)
  84.   (setq e10s (cdr (assoc 1 e10)))
  85.   (setq new (getstring (strcat "enter TJZDH<" e10s ">:")))
  86.   (if (/= new "") (setq e10s new))
  87.   (command "text" "c" (list (+ p2x (* 4.0 zh))
  88.     (cadr (cdr (assoc 10 e10)))) (cdr (assoc 40 e10)) 0.0 e10s)
  89.   (redraw e2 4)
  90. )
  91. ;-------
  92. (defun insczh (fn1)
  93.   (setq pt (getpoint "enter point pt:"))
  94.   (setq ptx (car pt) pty (cadr pt))
  95.   (setq zh (getdist "\n Height <3.5>:" pt))
  96.     (if (null zh) (setq zh 3.5)) (setq zh (* tb 100 zh))
  97.   (setq fn1 (strcat "hz/" fn1 ".czh"))
  98.   (setq f1 (open fn1 "r"))
  99.   (setq s12 (read-line f1))
  100.   (setq k 0)
  101.   (while k
  102.     (setq s12 (read-line f1))
  103.     (if (= s12 nil) (setq k nil) (progn
  104.       (if (= wxr "MC") (progn
  105.       (setq s02 (cadr (read s12)))
  106.       (command "text" (list ptx (+ pty (* k -1.2 zh))) zh 0.0 s02)))
  107.       (if (= wxr "TJ") (progn
  108.       (setq s01 (car (read s12)))
  109.       (command "text" (list ptx (+ pty (* k -2.0 zh))) zh 0.0 s01)
  110.       (setq s02 (cadr (read s12)))
  111.       (command "text" (list (+ ptx (* 6 zh)) (+ pty (* k -2.0 zh)))
  112.         zh 0.0 s02)))
  113.       (setq k (1+ k)))
  114.     )
  115.   )
  116.   (close f1)
  117. )
  118. ;------------
  119. (defun chastr ( )
  120.   (print "Select string:")
  121.   (setq ppp (ssget))
  122.   (setq k 0 n (sslength ppp))
  123.   (while (< k n)
  124.     (setq e1 (ssname ppp k))
  125.     (setq e10 (entget e1))
  126.       (redraw e1 3)
  127.       (setq new (getstring (strcat
  128.         "enter new string<" (cdr (assoc 1 e10)) ">:")))
  129.       (if (/= new "") (progn
  130.         (setq e10 (subst (cons 1 new) (assoc 1 e10) e10))
  131.         (entmod e10)))
  132.     (redraw e1 4)
  133.     (setq k (1+ k))
  134.   )
  135. )
  136. ;-----------
  137. ;(defun C:CLEAN2 ( )
  138. ; (setq atomlist (member 'C:CLEAN2 atomlist))
  139. ; (princ)
  140. ;)
  141.