home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p065 / 4.img / SAN.LSP < prev    next >
Encoding:
Text File  |  1991-05-24  |  1.8 KB  |  66 lines
  1. (vmon)
  2.  
  3. (defun sanerr(s)
  4.    (if (/= s "Function cancelled")
  5.        (princ (strcat "\nError:" s))
  6.    )
  7.    (command "layer" "s" "0" "")
  8.    (setvar "cmdecho" 1)
  9.    (setvar "osmode" 0)
  10.    (setq *error* oer)
  11.    (princ)
  12. )
  13.  
  14. (defun C:SAN(/ x oer loop sp ep pl pl1 p ssw sn sn1 sn2 en ang l n)
  15.    (setvar "cmdecho" 0)
  16.    (setq oer *error* *error* sanerr)
  17.    (princ "\n╔ó╦«┐φ╢╚ <500>:")
  18.    (setq x (getint))
  19.    (if (/= x nil) (setq ssw x) (setq ssw 500))
  20.    (graphscr)
  21.    (setq loop t)
  22.    (while loop
  23.    (initget "ON OFF")
  24.    (setq sp (getpoint "\n╢╦╡πON/OFF/<╔ó╦«╞≡╡π>:"))
  25.    (cond ((= sp "ON") (setvar "osmode" 1))
  26.          ((= sp "OFF") (setvar "osmode" 0))
  27.          (t (setq loop nil))
  28.    ))
  29.    (setq pl nil pl (cons sp pl))
  30.    (while sp
  31.      (initget "Undo")
  32.      (setq ep (getpoint sp "\n╗╪═╦U/<╧┬╥╗╡π>:"))
  33.      (if (= ep "Undo") (if (> (length pl) 1) (setq pl (cdr pl) sp (car pl)) (princ "*╗╪═╦═Ω┴╦*"))
  34.          (if (/= ep nil) (setq pl (cons ep pl) sp ep) (setq sp ep))
  35.      )
  36.    )
  37.    (setq pl (reverse pl) sp (nth 0 pl) n 1)
  38.    (setvar "osmode" 0)
  39.    (command "layer" "m" "pother" "")
  40.    (command "pline" sp "w" "0" "")
  41.    (repeat (- (length pl) 1)
  42.      (command (nth n pl))
  43.      (setq n (1+ n))
  44.    )
  45.    (command)
  46.    (setq sn (entlast))
  47.    (setq ep (nth 1 pl) ang (angle sp ep) p (polar sp (- ang 1.57079) ssw))
  48.    (command "offset" "t" (list sn sp) p "")
  49.    (setq sn1 (entlast))
  50.    (setq sn2 (entnext sn1) pl1 nil)
  51.    (while (/= "SEQEND" (cdr (assoc 0 (setq en (entget sn2)))))
  52.      (setq ep (cdr (assoc 10 en)) pl1 (cons ep pl1))
  53.      (setq sn2 (entnext sn2))
  54.    )
  55.    (setq pl1 (reverse pl1) l (length pl) n 0)
  56.    (repeat l
  57.       (command "pline" (nth n pl) (nth n pl1) "")
  58.       (setq n (1+ n))
  59.    )
  60.    (command "layer" "s" "0" "")
  61.    (setvar "cmdecho" 1)
  62.    (setvar "osmode" 0)
  63.    (setq *error* oer)
  64.    (princ)
  65. )
  66.