home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p065 / 4.img / COLUME.LSP < prev    next >
Encoding:
Text File  |  1992-02-01  |  3.4 KB  |  113 lines
  1. (VMON)
  2.  
  3. (defun clmerr(s)
  4.    (if (/= s "Function cancelled")
  5.        (princ (strcat "\nError:" s))
  6.    )
  7.    (command)
  8.    (command "layer" "s" "0" "")
  9.    (setvar "blipmode" 1)
  10.    (setvar "cmdecho" 1)
  11.    (setvar "osmode" 0)
  12.    (setq *error* oer)
  13.    (princ)
  14. )
  15.  
  16. (setq cn "COLUMN" cl 500 cw 500 ins "Mid" angc 0)
  17.  
  18. (defun C:COLUME(/ oer x osm p p0 p1 p2 p3 p4 ss ssl sn sn1 n n1 pt pe dx dy en en1)
  19. (setvar "cmdecho" 0)
  20. (setvar "OSMODE" 0) (setq osm 0)
  21. (setq oer *error* *error* clmerr)
  22. (command "layer" "m" "pother" "")
  23. (setq pe 0 dx 0 dy 0)
  24. (while (/= pe nil)
  25. (initget "P I R ON OFF")
  26. (setq p (getpoint "\nP╓∙▓╬╩²/I╜╗╡π▓σ╓∙/R▓╬┐╝╡π/ON/OFF <▓σ╚δ╡π>:"))
  27. (cond ((= p nil) (setq pe nil))
  28.       ((eq p "P")
  29.        (progn
  30.        (princ "\n╓∙╫╙├√│╞ <")
  31.        (princ cn)
  32.        (setq x (getstring ">:") cn (if (eq x "") cn x))
  33.        (princ "\n╓∙╫╙┐φ╢╚ <")
  34.        (princ cl)
  35.        (setq x (getint ">:") cl (if x x cl))
  36.        (princ "\n╓∙╫╙╕▀╢╚ <")
  37.        (princ cw)
  38.        (setq x (getint ">:") cw (if x x cw))
  39.        (initget "Up Dn Lf Rt Mid")
  40.        (princ "\n▓σ╚δ╡π╬╗╓├ <Up╔╧/Dn╧┬/Lf╫≤/Rt╙╥/Mid╓╨╨─ <")
  41.        (princ ins)
  42.        (setq x (getkword ">:") ins (if (= x nil) ins x))
  43.        (cond ((eq ins "Up") (setq dx (/ cw 2) dy 270))
  44.              ((eq ins "Dn") (setq dx (/ cw 2) dy 90))
  45.              ((eq ins "Lf") (setq dx (/ cl 2) dy 0))
  46.              ((eq ins "Rt") (setq dx (/ cl 2) dy 180))
  47.              ((eq ins "Mid") (setq dx 0 dy 0))
  48.              (t (setq ins "Mid" dx 0 dy 0))
  49.        )
  50.       (princ "\n╓∙╫╙╜╟╢╚ <")
  51.       (princ angc)
  52.       (setq x (getint ">: ") angc (if x x angc))
  53.      (setq dy (+ dy angc) dy (/ (* pi dy) 180))
  54.        )
  55.       )
  56.       ((eq p "I")
  57.        (progn
  58.        (setvar "OSMODE" 0)
  59.        (setq ss (ssget))
  60.        (if ss (progn (setq ssl (sslength ss) n 0)
  61.        (repeat (1- ssl)
  62.           (setq sn (ssname ss n) en (entget sn) n (1+ n))
  63.           (if (= "LINE" (cdr (assoc 0 en)))
  64.               (progn
  65.               (setq n1 n)
  66.               (setq p1 (cdr (assoc 10 en)) p2 (cdr (assoc 11 en)))
  67.               (repeat (- ssl n1)
  68.               (setq sn1 (ssname ss n1) en1 (entget sn1) n1 (1+ n1))
  69.               (if (= "LINE" (cdr (assoc 0 en1)))
  70.                   (progn
  71.                   (setq p3 (cdr (assoc 10 en1)) p4 (cdr (assoc 11 en1)))
  72.                   (setq pt (inters p1 p2 p3 p4))
  73.                   (if (/= pt nil)
  74.                       (command "insert" cn (polar pt dy dx) (/ cl 1000.0) (/ cw 1000.0) angc)
  75.                   )
  76.                   )
  77.               )
  78.               )
  79.               )
  80.            )
  81.        )
  82.   ))
  83.     (setvar "OSMODE" osm)
  84.    )
  85. )
  86. ((eq p "R") (progn
  87.             (setq p (getpoint "\n▓╬┐╝╡π:"))
  88.             (setvar "OSMODE" 0)
  89.             (setq p (getpoint p "\n▓σ╚δ╡π:"))
  90.             (command "insert" cn (polar p dy dx) (/ cl 1000.0) (/ cw 1000.0) angc)
  91.             (setvar "OSMODE" osm)
  92.             ))
  93. ((eq p "ON") (progn
  94.              (setvar "OSMODE" 8)
  95.              (setq osm 8)
  96.             (princ "▓╢╫╜╓ß╧▀╡π┤≥┐¬")
  97.              ))
  98. ((eq p "OFF") (progn
  99.              (setvar "OSMODE" 0)
  100.              (setq osm 0)
  101.             (princ "▓╢╫╜╓ß╧▀╡π╣╪▒╒")
  102.              ))
  103. (t (command "insert" cn (polar p dy dx) (/ cl 1000.0) (/ cw 1000.0) angc))
  104. )
  105. )
  106. (command "layer" "s" "0" "")
  107. (setvar "cmdecho" 1)
  108. (setvar "blipmode" 1)
  109. (setvar "OSMODE" 0)
  110. (setq *error* oer)
  111. (princ)
  112. )
  113.