home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p065 / 4.img / LTD.LSP < prev    next >
Encoding:
Text File  |  1992-02-11  |  2.0 KB  |  52 lines
  1.  
  2. (defun C:LTD(/ sn sn2 en oer elay dse1 dse2 kword sp ep mp mp1 mp2 mp3 mp4 plw ang1 ang0 ang2 oldpick)
  3.    (setvar "ORTHOMODE" 0)
  4.    (setq sn nil)
  5.    (while (= sn nil) 
  6.    (setq sn (entsel "\n╤í╘±╢╧┴╤╧▀:") sn (car sn))
  7.    (if sn (progn
  8.    (setq en (entget sn) ename (cdr (assoc 0 en)) elay (cdr (assoc 8 en)))
  9.      (if (and (= ename "LINE") (= elay "PSTAIR")) (progn
  10.    (setq sp (cdr (assoc 10 en)) ep (cdr (assoc 11 en)) mp (polar sp (angle sp ep) (/ (distance sp ep) 2.0)))
  11.    (princ "\n╚╖╢¿╢╧┴╤╧▀╖╜╧≥:")
  12.    (command "rotate" sn "" mp pause)
  13.    (setq en (entget sn))
  14.    (command "u")
  15.    (setq sp (cdr (assoc 10 en)) ep (cdr (assoc 11 en)) mp (polar sp (angle sp ep) (/ (distance sp ep) 2.0)))
  16.    (setq plw (getvar "userr1") ang1 (angle sp ep) ang0 (- ang1 1.57079) ang2 (+ ang1 1.57079))
  17.    (setq mp1 (polar mp ang1 plw) mp2 (polar mp (+ ang1 pi) plw))
  18.    (setq mp3 (polar (polar mp1 (+ ang1 pi) (/ plw 2.0)) ang2 plw))
  19.    (setq mp4 (polar (polar mp2 ang1 (/ plw 2.0)) ang0 plw))
  20.    (setq sp (polar sp (angle ep sp) (/ (distance sp mp) 2.0)))
  21.    (setq ep (polar ep ang1 (/ (distance mp ep) 2.0))) 
  22.    (command "layer" "m" "pstair2" "")
  23.    (command "pline" sp "w" 0 "" mp2 mp4 mp3 mp1 ep "")
  24.    (setq dse1 (entlast))
  25.    (command "copy" dse1 "" mp (polar mp ang2 (* 0.5 plw)))
  26.    (setq dse2 (entlast))
  27.      )
  28.      (setq sn nil))
  29.    ))
  30.    );while
  31.    (command "zoom" "w" sp ep) 
  32.    (setq oldpick (getvar "PICKBOX"))
  33.    (setvar "PICKBOX" 2)
  34.    (setq sn t) 
  35.    (while sn 
  36.    (setq sn (entsel "\n╤í╘±╥¬╝⌠╟╨╡─┬Ñ╠▌╧α╣╪╧▀:") sn2 (car sn))
  37.    (if sn2 (progn
  38.    (setq en (entget sn2) elay (cdr (assoc 8 en)))
  39.     (if (= elay "PSTAIR")
  40.           (command "trim" dse2 dse1 "" sn ""))
  41.           )
  42.           (progn
  43.           (setq kword "No")
  44.           (initget "Yes No")
  45.           (setq kword (getkword "\n╩╟╖±╝╠╨°╤í╘±? Yes/No <N>:"))
  46.           (if (= kword "Yes") (setq sn 1) (setq sn nil))
  47.    ))
  48.    );while
  49.    (command "zoom" "p")
  50.    (setvar "PICKBOX" oldpick)
  51. )
  52.