home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / APPS / CAD / PKEY11_1.ZIP / ACAD.LSP < prev    next >
Encoding:
Text File  |  1992-03-14  |  1.9 KB  |  66 lines
  1. ;                     ********Patrick J. McKee, author********
  2. ;                       ****Copyright 1992, Power Key tm****
  3. ;
  4. ;PATRICK J. McKEE
  5. ;Rt 1, Box 5
  6. ;Combs, Arkansas   72721
  7. ;
  8. (VMON)
  9. (defun dtr (angg)
  10. (* pi (/ a1 180.0)))
  11. (defun sub (var1 var2 /)
  12. (setq t2 (assoc var1 te)
  13.       t3 (cons var1 t1)
  14.       te (subst t3 t2 te)))
  15. (defun pre ()
  16. (setq oce(getvar "cmdecho"))
  17. (setq oom (getvar "orthomode"))
  18. (setq clyr (getvar "clayer"))
  19. (setvar "regenmode" 1)
  20. (setvar "cmdecho" 0))
  21. (defun post ()
  22. (setvar "orthomode" oom)
  23. (setvar "cmdecho" oce)
  24. (command "layer" "s" clyr "")
  25. (terpri))
  26. (defun err (s)
  27. (if (/= s "Function cancelled")(princ (strcat "\nError: " s)))
  28. (setq *error* oer)(post)(princ))
  29. (defun err2 (s)
  30. (if (/= s "Function cancelled")(princ (strcat "\nError: " s)))
  31. (setq *error* oer)(princ))
  32. (defun rf ()
  33. (setvar "LASTPOINT" (getpoint "Reference point: "))
  34. (getpoint "\nEnter relative/polar coordinates (with @): "))
  35. (defun ref ()
  36. (setvar "LASTPOINT" (getpoint "Reference point: "))
  37. (setq ent1(entsel "\nEnter relative/polar coordinates (with @): ")))
  38. (defun wrf ()
  39. (setvar "LASTPOINT" (getpoint "Reference point: "))
  40. (setq pt1(getpoint "\nEnter relative/polar coordinates (with @): ")))
  41. (defun c:lc()
  42. (setq ss (ssget))
  43. (initget (+ 1 2 4))
  44. (setq lyr(cdr(assoc 8(entget(car(entsel "Pick item for new layer: "))))))
  45. (setq counter 0)
  46. (prompt "Changing layer...")
  47. (while
  48. (setq e(ssname ss counter))
  49. (setq etype(cdr (assoc 0 (entget e))))
  50. (progn
  51. (setq ent(entget e))
  52. (setq old(assoc 8 ent))
  53. (setq new(cons (car old) lyr))
  54. (setq ne(subst new old ent))
  55. (entmod ne))
  56. (setq counter(+ counter 1))
  57. (princ)))
  58. (defun c:s (/ lyr)
  59. (setq lyr(cdr(assoc 8(entget(car(entsel "Pick item for new layer: "))))))
  60. (command "layer" "s" lyr ""))
  61. (defun ASVE ( / s)
  62. (setq s(getvar"tdusrtimer"))
  63. (if(> s 0.0050)(command"time""r"""))
  64. (if(> s 0.0050)(command"save"""))
  65. (graphscr))
  66. (load"Key")