home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p047 / 4.ddi / LP / DMQP.LSP < prev    next >
Encoding:
Text File  |  1991-05-15  |  1.4 KB  |  41 lines
  1. ;****** LPM\DMQP.LSP ******
  2. (if (null tb) (setq tb 1.0))
  3. ;----------
  4. (defun C:DMQP ( )
  5. ; (if (/= (getvar "clayer") "lp") (command "layer" "m" "lp" ""))
  6.   (setq po (getpoint "enter SJSD po:"))
  7.   (command "text" "c" po (* 300 tb) 0.0 "PO")
  8.   (setq pox (car po) poy (cadr po))
  9.   (setq Pn-1 (getpoint "Start point:" po))
  10.   (if (= mmm "mm") (setq b 1100.0) (setq b 1.1))
  11.    (setq b (- (+ (cadr pn-1) b) poy)) (setq yn-1 b)
  12.   (setq xn-1 (- (car pn-1) pox))
  13.   (setq f (getreal "enter PJ 800/850/900 <800>:"))
  14.   (if (null f) (setq f 800.0))
  15.   (if (= mmm "m") (setq f (* f 0.001)))
  16.   (setq pn-1 (polar pn-1 0.0 (* -0.5 f)))
  17.   (setq dc (getreal "enter DC 120/60/40 <60>:"))
  18.   (if (null dc) (setq dc 60.0))
  19.   (if (= mmm "m") (setq dc (* dc 0.001)))
  20.   (setq se (getvar "elevation")) (setvar "elevation" 0.0)
  21.   (setq st (getvar "thickness")) (setvar "thickness" 0.0)
  22.   (setq wcy 1)
  23.   (while wcy
  24.     (setq wcy (getstring "continurse? y/n <y>"))
  25.     (if (= wcy "n") (setq wcy nil) (progn
  26.       (setq xn (+ xn-1 f))
  27.       (setq yn (/ (* (+ yn-1 dc) xn) xn-1))
  28.       (setq dh (- yn yn-1))
  29.       (if (< dh (* 0.2 f)) 
  30.         (command "pline" Pn-1
  31.         (setq pn-1 (list (+ (car pn-1) f) (+ (cadr pn-1) dh))) "")
  32.         (command "pline" Pn-1 (polar pn-1 0.0 f)
  33.         (setq pn-1 (list (+ (car pn-1) f) (+ (cadr pn-1) dh))) "")
  34.       )
  35.       (setq xn-1 xn yn-1 yn))
  36.     )
  37.   )
  38.   (setvar "elevation" se)
  39.   (setvar "thickness" st)
  40. )
  41.