home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p190 / 3.ddi / LSP / T1.LSP < prev    next >
Encoding:
Text File  |  1990-07-20  |  2.3 KB  |  69 lines
  1. (princ "\n┤╦│╠╨≥╬¬▒Σ╚²╘▓(╗í)╬¬╥╗:╙├├ⁿ┴ε 3t1 ╡≈╙├.")
  2. (princ)
  3. (defun C:3t1 ()
  4.    (setvar "pickbox" 2)
  5.    (setvar "cmdecho" 1)
  6.    (princ "\n╟δ╓╕│÷╨▐╕─╡─╟°╙≥:")
  7.    (setq pt (getpoint "\n╡┌╥╗╜╟:"))
  8.    (setq pt1(getcorner pt "\n┴φ╥╗╜╟:"))
  9.    (setq p (ssget "w" pt pt1))
  10.    (if (/= p nil)
  11.      (progn (setq n (sslength p))
  12.             (setq i 0)
  13.             (while (< i n)
  14.               (setq e (ssname p i))
  15.               (if (or (= (cdr (assoc 0 (entget e))) "CIRCLE")
  16.                   (= (cdr (assoc 0 (entget e))) "ARC"))
  17.                   (hj02)
  18.                   (setq i (1+ i))
  19.                )
  20.            )
  21.     ))
  22. )
  23. (defun hj02 ()
  24.    (setq na (cdr (assoc 0 (entget e)))
  25.          pt (cdr (assoc 10 (entget e)))
  26.           r (cdr (assoc 40 (entget e))))
  27.    (setq p1 (ssget "c" (polar pt 0 (+ r 3.5))
  28.                        (polar pt 0 (- r 3.5))))
  29.    (setq k (sslength p1) j 0 r2 nil r3 nil)
  30.    (while (< j k)
  31.     (print "j= ") (princ j)
  32.      (setq e1 (ssname p1 j))
  33.      (if (and (/= e1 e)
  34.          (equal pt (cdr (assoc 10 (entget e1))))
  35.          (= (cdr (assoc 0 (entget e1))) NA))
  36.          (progn
  37.          (if (<= (abs (- r (cdr (assoc 40 (entget e1))))) 3.5)
  38.          (progn (cond ((and (= r2 nil) (= r3 nil))
  39.                         (setq r2 (cdr (assoc 40 (entget e1))))
  40.                         (setq e2 e1 i (1+ i))
  41.                        (if (> r2 r) (setq a 1) (setq a 0)))
  42.                       ((and (/= r2 nil) (= r3 nil))
  43.                        (setq r3 (cdr (assoc 40 (entget e1))))
  44.                        (if (and (> a 1) (< r3 r))
  45.                        (progn (setq a e2 b e1)))
  46.                        (if (and (> a 1) (> r3 r2))
  47.                        (progn (setq a e b e2)))
  48.                        (if (and (< a 1) (> r3 r))
  49.                        (progn (setq a e1 b e2))
  50.                        (progn (setq a e1 b e)))
  51.                        (entdel a)
  52.                        (entdel b)
  53.                        (setq p (ssdel e p))
  54.                        (setq p (ssdel e1 p))
  55.                        (setq p (ssdel e2 p))
  56.                        (setq i 0 n (sslength p))
  57.                        (setq r2 nil r3 nil)
  58.                        (princ "\n╒╥╡╜╥╗╕÷─┐▒Ω.")
  59.                       )
  60.             )
  61.         )
  62.         (setq i (1+ i))
  63.         )
  64.         )
  65.       )
  66.      (setq j (1+ j))
  67.   )
  68. )
  69.