home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p047 / 4.ddi / PM / APM.LSP < prev    next >
Encoding:
Text File  |  1989-10-15  |  3.2 KB  |  96 lines
  1. ;****** PM\Apm.LSP ****** 10-13-89
  2. (defun C:APM ( )
  3.   (setvar "osmode" 0)
  4.   (if (or (= mmm "m") (= mmm "M")) (setq ss "\n !mmm=m,")
  5.     (setq ss "!mmm=mm,"))
  6.   (setq aa (getreal "enter A=?m2 <1500>:"))
  7.   (if (null aa) (setq aa 1500.0))
  8.   (setq mode 1)
  9.   (while mode
  10.     (setq mode (getint "\n 1.ZFX/2.CFX/3.DBX/4.circle/5.SX
  11.       <or RETRUN for none>:"))
  12.     (if (= mode 1) (zfx))
  13.     (if (= mode 2) (cfx))
  14.     (if (= mode 3) (dbx))
  15.     (if (= mode 4) (cir))
  16.     (if (= mode 5) (sx))
  17.   )
  18. )
  19. ;-----------
  20. (defun zfx ( )
  21.   (setq bc (sqrt aa))
  22.   (setq nbc (getreal (strcat "new BC=?m" " <" (rtos bc 2 2) ">:")))
  23.   (if nbc (setq bc nbc))
  24.   (setq aas (rtos (* bc bc) 2 2))
  25.   (prompt (strcat "area=" aas "M2,"))
  26.   (if (= ss "!mmm=mm,") (setq bc (* 1000.0 bc)))
  27.   (setq p1 (getpoint "enter point p1:"))
  28.   (command "pline" p1 (setq p2 (polar p1 0.0 bc))
  29.     (polar p2 (* 0.5 pi) bc) (polar p1 (* 0.5 pi) bc) "c")
  30.   (command "text" (polar p1 (* -0.5 pi) (* 750 tb))
  31.     (* 350 tb) 0.0 (strcat "├µ ╗²=" aas "M2"))
  32. )
  33. ;-----------
  34. (defun cfx ( )
  35.   (setq xbc (getreal "enter xBC=?m:"))
  36.   (setq ybc (/ aa xbc))
  37.   (setq nybc (getreal (strcat "new yBC=?m <" (rtos ybc 2 2) ">:")))
  38.   (if nybc (setq ybc nybc))
  39.   (setq aas (rtos (* xbc ybc) 2 2))
  40.   (prompt (strcat "area=" aas "M2,"))
  41.   (if (= ss "!mmm=mm,")
  42.     (setq xbc (* 1000.0 xbc) ybc (* 1000.0 ybc)))
  43.   (setq p1 (getpoint "enter point p1:"))
  44.   (command "pline" p1 (setq p2 (polar p1 0.0 xbc))
  45.     (polar p2 (* 0.5 pi) ybc) (polar p1 (* 0.5 pi) ybc) "c")
  46.   (command "text" (polar p1 (* -0.5 pi) (* 750 tb))
  47.     (* 350 tb) 0.0 (strcat "├µ ╗²=" aas "M2"))
  48. )
  49. ;-----------
  50. (defun dbx ( )
  51.   (setq n (getint "enter n <6>:"))
  52.   (if (null n) (setq n 6))
  53.   (setq a0 (/ pi n))
  54.   (setq r (sqrt (/ aa (* n (sin a0) (cos a0)))))
  55.   (setq nr (getreal (strcat "new r=?m <" (rtos r 2 2) ">:")))
  56.   (if nr (setq r nr))
  57.   (setq aas (rtos (* r r (sin a0) (cos a0) n) 2 2))
  58.   (prompt (strcat "area=" aas "M2,"))
  59.   (if (= ss "!mmm=mm,") (setq r (* 1000.0 r)))
  60.   (setq p0 (getpoint "enter point p0:"))
  61.   (command "polygon" n p0 "i" r)
  62.   (command "text" (polar p0 (* -0.5 pi) (* 750 tb))
  63.     (* 350 tb) 0.0 (strcat "├µ ╗²=" aas "M2"))
  64. )
  65. ;-----------
  66. (defun cir ( )
  67.   (setq r (sqrt (/ aa pi)))
  68.   (setq nr (getreal (strcat "new R=?m <" (rtos r 2 2) ">:")))
  69.   (if nr (setq r nr))
  70.   (setq aas (rtos (* pi r r) 2 2))
  71.   (prompt (strcat "area=" aas "M2,"))
  72.   (if (= ss "!mmm=mm,") (setq r (* 1000.0 r)))
  73.   (setq p0 (getpoint "enter point p0:"))
  74.   (command "circle" p0 r)
  75.   (command "text" (polar p0 (* -0.5 pi) (* 750 tb))
  76.     (* 350 tb) 0.0 (strcat "├µ ╗²=" aas "M2"))
  77. )
  78. ;-----------
  79. (defun sx ( )
  80.   (setq a0 (getreal "enter a0 <90>:"))
  81.   (if (null a0) (setq a0 90.0))
  82.   (setq a0 (* pi (/ a0 180.0)))
  83.   (setq r (sqrt (/ (* aa 2.0) a0)))
  84. ; (setq r (sqrt (/ aa a0)))
  85.   (setq nr (getreal (strcat "new r=?m <" (rtos r 2 2) ">:")))
  86.   (if nr (setq r nr))
  87.   (setq aas (rtos (* r r 0.5 a0) 2 2))
  88.   (prompt (strcat "area=" aas "M2,"))
  89.   (if (= ss "!mmm=mm,") (setq r (* 1000.0 r)))
  90.   (setq a0 (* 180.0 (/ a0 pi)))
  91.   (setq p0 (getpoint "enter point p0:"))
  92.   (command "pline" p0 (polar p0 0.0 r) "a" "a" a0 "c" p0 "l" "cl")
  93.   (command "text" (polar p0 (* -0.5 pi) (* 750 tb))
  94.     (* 350 tb) 0.0 (strcat "├µ ╗²=" aas "M2"))
  95. )
  96.