home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / APPS / CAD / PKEY11_1.ZIP / KY.LSP < prev    next >
Encoding:
Text File  |  1992-03-14  |  2.3 KB  |  71 lines
  1. ;Add a key note to your drawing (handy)
  2. ;
  3. ;                     ********Patrick J. McKee, author********
  4. ;                       ****Copyright 1992, Power Key tm****
  5. ;
  6. (defun kyerr (s)
  7. (if (/= s "Function cancelled")(princ (strcat "\nError: " s)))
  8. (setq rw *rw)
  9. (setq tg *tg)
  10. (setq kb *kb)
  11. (setvar "orthomode" OM)
  12. (setq *error* olderr)
  13. (princ))
  14. (defun dtr (angg)
  15. (* pi (/ angg 180.0)))
  16. (setq olderr *error* *error* kyerr)
  17. (if (= *rw nil)(setq *rw "A")
  18. (setq rw *rw))
  19. (if (= *tg nil)(setq *tg "S")
  20. (setq tg *tg))
  21. (if (= *kb nil)(setq *kb "R")
  22. (setq kb *kb))
  23. (setq OM(getvar"orthomode"))
  24. (IF (= scf nil)(SETQ SCF (GETREAL "\nENTER SCALE FACTOR FOR THIS SHEET: "))
  25. (SETQ *SCF SCF))
  26. (SETQ arw(GETSTRING (STRCAT "\n(A)rch. arrow. (D)im arrow.  Do(T). < ")
  27. (PROMPT *rw)
  28. (prompt "\ >")
  29. (princ)))
  30. (if(= arw "")(setq arw *rw)(setq *rw arw))
  31. (IF(OR(= arw "A")(= arw "a"))(SETQ arw "aarw"))
  32. (IF(OR(= arw "D")(= arw "d"))(SETQ arw "darw"))
  33. (IF(OR(= arw "T")(= arw "t"))(SETQ arw "dota"))
  34. (SETQ TAG
  35. (GETSTRING(strcat"\n(H)ex. (C)ircle. (S)quare. (E)llipse.(Tr)iangle.< ")
  36. (prompt *tg)
  37. (prompt "\ >")
  38. (princ)))
  39. (if(= tag "")(setq tag *tg)(setq *tg tag))
  40. (IF(OR(= tag "H")(= tag "h"))(SETQ tag "hex"))
  41. (IF(OR(= tag "S")(= tag "s"))(SETQ tag "sqr"))
  42. (IF(OR(= tag "C")(= tag "c"))(SETQ tag "cir"))
  43. (IF(OR(= tag "E")(= tag "e"))(SETQ tag "ell"))
  44. (IF(OR(= tag "TR")(= tag "tr"))(SETQ tag "tri"))
  45. (SETQ KBLK
  46. (GETSTRING(strcat"\nKEYNOTE (R)IGHT. (L)EFT. (T)OP. (B)OTTOM. < ")
  47. (prompt *kb)
  48. (prompt "\ >")
  49. (princ)))
  50. (if(= kblk "")(setq kblk *kb)(setq *kb kblk))
  51. (IF(OR(= KBLK "R")(= KBLK "r"))(SETQ KBLK (strcat tag "R")))
  52. (IF(OR(= KBLK "B")(= KBLK "b"))(SETQ KBLK (strcat tag "B")))
  53. (IF(OR(= KBLK "L")(= KBLK "l"))(SETQ KBLK (strcat tag "L")))
  54. (IF(OR(= KBLK "T")(= KBLK "t"))(SETQ KBLK (strcat tag "T")))
  55. (setq kt(getstring  T "\nEnter keynote number : "))
  56. (setq FP(getpoint "\nPick leader startpoint : "))
  57. (setvar "orthomode" 0)
  58. (setq SP(getpoint  FP "\nsecond point: "))
  59. (command "line" fp sp "")
  60. (setvar "orthomode" 1)
  61. (setq EP(getpoint  sp "\nend point: "))
  62. (IF(= EP NIL)(SETQ EP SP))
  63. (setq a1(angle fp sp))
  64. (setq a2(* a1 57.2958))
  65. (command"insert" arw fp scf "" a2)
  66. (command"line" sp ep "")
  67. (command"insert" KBLK ep SCF "" "0" kt)
  68. (setvar "orthomode" om)
  69. (setq fp nil sp nil ep nil a1 nil a2 nil arw1 nil kt nil kblk1 nil)
  70. (setq *error* olderr)
  71. (princ)