home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p047 / 4.ddi / ZT / AREASJ.LSP next >
Encoding:
Text File  |  1989-10-08  |  1.5 KB  |  46 lines
  1. ;****** ZT\AREASJ.LSP ******
  2.   (if (null zh) (setq zh (* 350 tb)))
  3.   (if (null af0) (setq af0 0.0))
  4. ;********** C:PLSJ **********
  5. (defun C:PLSJ ( )
  6.   (setq ss1 (car (entsel "select polyline:")))
  7.   (if (/= (cdr (assoc 0 (entget ss1))) "POLYLINE")
  8.     (prompt "not a polyline") (progn
  9.       (prompt "1 found")
  10.       (command "area" "e" ss1)
  11.       (setq mj (getvar "area") zc (getvar "perimeter"))
  12.       (if (= mmm "mm") (setq mj (* 0.000001 mj) zc (* 0.001 zc)))
  13.       (pah)
  14.       (command "text" pt zh af0 (strcat (rtos mj 2 2) "m2"))
  15.       (command "text" "" (strcat (rtos zc 2 2) "m"))))
  16. )
  17. (defun C:AREASJ ( )
  18. ;     (command "area")
  19.   (setq mj (getvar "area") zc (getvar "perimeter"))
  20.   (if (= mmm "mm") (setq mj (* 0.000001 mj) zc (* 0.001 zc)))
  21.   (setq wcy (getstring "MJ/ZC <mj>:"))
  22.     (if (or (= wcy "zc") (= wcy "ZC"))
  23.         (progn (pah) 
  24.       (command "text" pt zh af0 (strcat (rtos zc 2 3) "m")))
  25.         (progn (pah) 
  26.       (command "text" pt zh af0 (strcat (rtos mj 2 2) "m2")))
  27.     )
  28. )
  29. (defun pah ( )
  30.   (if (/= (getvar "clayer") "SJ")
  31.      (command "layer" "m" "sj" "c" "1" "" ""))
  32.   (setq pt (getpoint "\n Start point:"))
  33.   (setq zh (* 250 tb))
  34.   (setq af0 0.0)
  35. )
  36. (defun pah1 ( )
  37.   (if (/= (getvar "clayer") "SJ")
  38.      (command "layer" "m" "sj" "c" "1" "" ""))
  39.   (setq pt (getpoint "\n Start point:"))
  40.   (setq af0 (getangle "\n Angle <0>:" pt))
  41.     (if (null af0) (setq af0 0.0))
  42.   (setq af0 (* 180 (/ af0 pi)))
  43.   (setq zh (getdist "\n Height <3.5>:" pt))
  44.     (if (null zh) (setq zh 3.5)) (setq zh (* tb 100 zh))
  45. )
  46.