[编程交流] rar公司

 
;;                         SQFT Area Lisp Program
;;                          Ghostrider @ Cadtutor     
;;                      WRITTEN:November 11, 1994
(defun c:SQ2 (/    P1  P2    P3    P4    P5  P6    A     B
     C    D  E     F     PT    PTLIST      OS    ss
     ssl   wl  ctr   l1    l2    wn  wlist llist vlist
     bn    dlist dllist      dvlist
    )
 (setvar "CMDECHO" 0)
 (setq wl 0)
 (setq E 0)
 (setq D 0)
 (setq OS (getvar "OSMODE"))
   (setq l1 70)
 (setvar "OSMODE" 32)
 (while (/= nil
     (setq PT
     (getpoint
       "\nPick a room corner point, press return when done: _int "
     )
     )
     (progn
       (if PT
  (/= nil (setvar "lastpoint" PT))
       )
       (setq PTLIST (cons PT PTLIST))
     )
 )
 )
 (setq PTLIST (reverse PTLIST))
 (setvar "OSMODE" 0)
 (command "PLINE")
 (while (/= nil
     (car PTLIST)
     (progn
       (command (car PTLIST))
       (setq PTLIST (cdr PTLIST))
     )
 )
 )
 (command "AREA" "e" "l" "ERASE" "l" "")
 (setvar "OSMODE" OS)
 (command "redraw")
 (setq A (/ (getvar "area") 144))
 (setq P1 (getpoint "\nPick center point of text: "))
 (setq P2 (list (car P1) (- (cadr P1) 5)))
 (setq P3 (list (car P1) (- (cadr P2) 5)))
 (setq P4 (list (car P1) (- (cadr P3) 5)))
 (setq P5 (list (car P1) (- (cadr P4) 5)))
 (setq P6 (list (car P1) (- (cadr P5) 5)))
 (command "text" "c" P1 6 0 (strcat (rtos A 2 2) " SQFT."))
 (setvar "cmdecho" 1)
 (princ)
 ); end of c:SQ2
(princ "\n*** Type SQ2 to add sq root of room *** ")

 
(command "AREA" "e" "l" "ERASE" "l" "")
 (setvar "OSMODE" OS)
 (command "redraw")
 (setq A (getvar "perimeter") 
(setq P1 (getpoint "\nPick center point of text: "))
 (setq P2 (list (car P1) (- (cadr P1) 5)))
 (setq P3 (list (car P1) (- (cadr P2) 5)))
 (setq P4 (list (car P1) (- (cadr P3) 5)))
 (setq P5 (list (car P1) (- (cadr P4) 5)))
 (setq P6 (list (car P1) (- (cadr P5) 5)))
 (command "text" "c" P1 6 0 (strcat (rtos A 2 2) " perimeter."))
 (setvar "cmdecho" 1)
 (princ)