home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1993 #2 / Image.iso / cad / jul93.zip / TIP885.LSP < prev    next >
Lisp/Scheme  |  1993-06-21  |  1KB  |  37 lines
  1. ; TIP885:  QAREA.LSP (C)1993, Coral King
  2. ; Quick Area
  3.  
  4. ;  Calculates the square footage bounded by a polyline, rounds out to nearest
  5. ;  foot, inserts a comma if greater than 999 s.f., and prints the text
  6. :  where you point.  Assumes a defined-height text style. 
  7. :  Written for R12, may work on others.  I wrote this routine to
  8. ;  facilitate calculating the area occupied by various departments. Aloha!
  9. ;--------------------------------------------------------------------------
  10. (defun c:Qarea () ;;;;;/ u1 u2 atx area1 re1 str1 n at2)
  11.      (command "cmdecho" 0)
  12.      (setq u1(getvar "lunits"))
  13.      (setq u2(getvar "luprec"))
  14.      (command "texteval" 1)
  15.      (setvar "osmode" 512)(setvar "lunits" 2)(setvar "luprec" 0)
  16.      (setq atx (getpoint "\nPick any point on boundary... "))
  17.      (command "area" "e" atx)
  18.      (setq area1 (getvar "area"))
  19.      (setq area1(/ area1 144))
  20.      (setq re1(rem area1 144))
  21.      (if (<= re1 72)
  22.      (setq area1 (- area1 re1))(setq area1 (+ area1 (- 144 re1))))
  23.      (setq str1 (rtos area1))
  24.      (setq n (strlen str1))
  25.      (if (> n 3)
  26.           (progn
  27.                 (setq fp(substr str1 1 (- n 3)))
  28.                 (setq lp(substr str1 (- n 3) 3))
  29.      (setq str1 (strcat fp "," lp))))
  30.      (setq at2  (getpoint "\nLocation for text... "))
  31.      (command "text" at2 0 str1)
  32.      (setvar "osmode" 0)
  33.      (setvar "luprec" u2)
  34.      (setvar "lunits" u1)
  35.      (command "cmdecho" 1)
  36. (princ))
  37.