home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / APPS / CAD / PKEY11_1.ZIP / DR.LSP < prev    next >
Encoding:
Text File  |  1992-03-14  |  1.9 KB  |  55 lines
  1. ;Base program for the door selection menu
  2. ;This program only works if the door symbols are there and the layers
  3. ;are correct.
  4. ;                     ********Patrick J. McKee, author********
  5. ;                       ****Copyright 1992, Power Key tm****
  6. ;
  7. (setq oer  *error*  *error*  err)
  8. (PRE)
  9. (if (= os1 nil)(setq os1 36))
  10. (setq dfop1 os1)
  11. (initget (+ 2 4))
  12. (setq os1(getdist(strcat "Enter door size <" (rtos os1) ">: ")))
  13. (if (= os1 nil)(setq os1 dfop1))
  14. (initget 1 "Left Right Center")
  15. (setq ptpk1(getkword "Break from Left/Right/Center: "))
  16. (setq ent1 (entsel "\nPick break point: "))
  17. (if(= ent1 nil)(ref))
  18. (setq e1 (car ent1))
  19. (setvar "aperture" 4)
  20. (setq p1 (car (cdr ent1)))
  21. (setq p1 (osnap p1 "near"))
  22. (setq lyrn (cdr (assoc 8 (entget e1))))
  23. (setq startpt (cdr (assoc 10 (entget e1))))
  24. (setq endpt (cdr (assoc 11 (entget e1))))
  25. (setq temp1 (osnap p1 "NEAR"))
  26. (setq atemp (angle (osnap p1 "end") temp1))
  27. (setq temp1 (polar p1 atemp 8))  ;reset temp1
  28. (setvar "aperture" 40)
  29. (entdel e1)
  30. (setq temp2(osnap temp1 "near"))
  31. (entdel e1)
  32. (setvar "aperture" 4)
  33. (setq up (/ pi 2))
  34. (setq dn (* pi 1.5))
  35. (setq a1 (angle startpt endpt))
  36. (cond((= ptpk1 "Left")(if(and (> a1 up)(<= a1 dn))(setq a1 (- a1 pi))))
  37.      ((= ptpk1 "Right")(if(or (<= a1 up)(> a1 dn))(setq a1 (+ a1 pi))))
  38.      ((= ptpk1 "Center")(setq p1(polar p1 a1 (* (/ os1 2) -1.0)))))
  39. (setq a2 (angle temp1 temp2))
  40. (setq p2 (polar p1 a1 os1))
  41. (setq p3 (polar p1 a2 (distance temp1 temp2)))
  42. (setq p4 (polar p2 a2 (distance temp1 temp2)))
  43. (command "layer" "M" lyrn "")
  44. (command "break" e1 p1 p2)
  45. (command "break" p3 "f" p3 p4)
  46. (command "line" p2 p4 "")
  47. (command "line" p1 p3 "")
  48. (setq halfwidth (/ (distance p1 p3) 2.0))
  49. (command "layer" "M" "aw" "")
  50. (setq dstpt(getpoint "\nPick hinge point of door: "))
  51. (setq drblk1(strcat "/kesym1/" drblk))
  52. (COMMAND"LAYER""M""ND""")
  53. (command "insert" drblk1 dstpt os1 "" pause )
  54. (POST)
  55. (princ)