home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 15 / CD_ASCQ_15_070894.iso / vrac / apr94cad.zip / TIP974.LSP < prev    next >
Text File  |  1994-03-11  |  4KB  |  122 lines
  1. ; TIP974.LSP: QL.LSP   Quick List   (c)1994, C. D. Iddings
  2.  
  3. (defun C:QL()
  4. (setvar "cmdecho" 0)
  5.  
  6. (defun *error* (msg)
  7. (princ "error :")
  8. (princ msg)
  9. (terpri)
  10. )
  11.  
  12. (defun aol()
  13. (setq p1 (cdr (assoc 10 (entget (car itm))))
  14.       p2 (cdr (assoc 11 (entget (car itm))))
  15.       a1 (angle p1 p2))
  16. (if (> a1 pi)(setq a1 (- a1 pi)))
  17. (setq a1 (* a1 (/ 180 pi))
  18.       lng (distance p1 p2))
  19. (prompt "\nLINE: ")
  20. (prompt "Angle is = ")
  21. (prompt (rtos a1 2 4))
  22. (prompt "  Length is = ")
  23. (prompt (rtos lng 2 4))
  24. );end aol
  25.  
  26. (defun arcd()
  27. (setq p1 (rtos (car (cdr (assoc 10 (entget (car itm))))) 2 4)
  28.       p2 (rtos (cadr (cdr (assoc 10 (entget (car itm))))) 2 4)
  29.       a1 (abs (- (cdr (assoc 50 (entget (car itm))))
  30.                  (cdr (assoc 51 (entget (car itm))))))
  31.       a1 (rtos (* a1 (/ 180 pi)) 2 4)
  32.       lng (rtos (cdr (assoc 40 (entget (car itm)))) 2 4 ))
  33. (prompt "\nARC: ")
  34. (prompt " C/L at <WCS>: ")
  35. (prompt (strcat p1 ", " p2))
  36. (prompt " Radius = ")
  37. (prompt lng)
  38. (prompt " Inc.Ang.= ")
  39. (prompt a1)
  40. );end arcd
  41.  
  42. (defun cird()
  43. (setq p1 (rtos (car (cdr (assoc 10 (entget (car itm))))) 2 4)
  44.       p2 (rtos (cadr (cdr (assoc 10 (entget (car itm))))) 2 4)
  45.       lng (rtos (* (cdr (assoc 40 (entget (car itm)))) 2) 2 4 )
  46.       a1 (rtos (* (* (cdr (assoc 40 (entget (car itm)))) 2) pi) 2 4)
  47.       rad (cdr (assoc 40 (entget (car itm))))
  48.       are (rtos (* rad rad pi)))
  49. (prompt "\nCIRCLE: ")
  50. (prompt " C/L at <wcs>:  ")
  51. (prompt (strcat p1 ", " p2))
  52. (prompt " Dia. = ")
  53. (prompt lng)
  54. (prompt " C  = ")
  55. (prompt a1)
  56. (prompt " A  = ")
  57. (prompt are)
  58. );end cird
  59.  
  60. (defun blkd()
  61. (setq p1 (rtos (car (cdr (assoc 10 (entget (car itm))))) 2 3)
  62.       p2 (rtos (cadr (cdr (assoc 10 (entget (car itm))))) 2 3)
  63.       sx (rtos (cdr (assoc 41 (entget (car itm)))) 2 3)
  64.       sy (rtos (cdr (assoc 42 (entget (car itm)))) 2 3)
  65.       aa (cdr (assoc 50 (entget (car itm))))
  66.       aa (rtos (* aa (/ 180 pi)) 2 3) 
  67.       nme (cdr (assoc 2 (entget (car itm)))))
  68. (prompt "\nBlock = ")
  69. (prompt nme)
  70. (prompt " :I/P at <WCS> ")
  71. (prompt (strcat p1 ", " p2))
  72. (prompt " :XS = ")
  73. (prompt sx)
  74. (prompt " :YS = ")
  75. (prompt sy)
  76. (prompt " :Rot = ")
  77. (prompt aa)
  78. );end blkd
  79.  
  80. (defun txtd()
  81. (setq ht (rtos (cdr (assoc 40 (entget (car itm)))) 2 3))
  82. (setq sty (cdr (assoc 7 (entget (car itm))))
  83.       jus (cdr (assoc 72 (entget (car itm))))
  84.       pt (cdr (assoc 11 (entget (car itm)))))
  85. (if (= jus 0)(setq pt (cdr (assoc 10 (entget (car itm))))))
  86. (setq ptx (rtos (car pt))
  87.       pty (rtos (cadr pt))
  88.       jus1 (cdr (assoc 73 (entget (car itm)))))
  89. (if (and (= jus 1)(= jus1 2))(setq jus 4))
  90.      (cond
  91.          ((= jus 0)(setq jus "L"))
  92.          ((= jus 1)(setq jus "C"))
  93.          ((= jus 2)(setq jus "R"))
  94.          ((= jus 3)(setq jus "ALI"))
  95.          ((= jus 4)(setq jus "MID"))
  96.          ((= jus 5)(setq jus "FIT")))
  97. (prompt "\nText Style = ")
  98. (prompt sty)
  99. (prompt ", Hgt. = ")
  100. (prompt ht)
  101. (prompt ", I/P <WCS> = ")
  102. (prompt ptx)
  103. (prompt "/")
  104. (prompt pty)
  105. (prompt ", Justfy. = ")
  106. (prompt jus)
  107. );end txtd
  108.  
  109. (setq itm (entsel "\nSelect Line, Arc, Circle, Text, or Block: ")
  110.       itmid (cdr (assoc 0 (entget (car itm)))))
  111.     (cond
  112.       ((= itmid "LINE")(aol)(setq itmid nil))
  113.       ((= itmid "ARC")(arcd)(setq itmid nil))
  114.       ((= itmid "CIRCLE")(cird)(setq itmid nil))
  115.         ((= itmid "INSERT")(blkd)(setq itmid nil))
  116.         ((= itmid "TEXT")(txtd)(setq itmid nil))
  117.         ((/= itmid nil)(prompt 
  118.                (strcat"\nFor info about that "itmid"  use LIST function :")))  
  119.     )
  120. (princ)
  121. )
  122.