home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p190 / 3.ddi / LSP / BG.LSP < prev    next >
Encoding:
Text File  |  1987-07-17  |  1.5 KB  |  40 lines
  1. ;***********************************
  2. ;*  this program to draw a table!  *
  3. ;***********************************
  4. (setq b (getstring "\nform of base point:Leftdown/Rightup: <L> "))
  5. (setq pt1 (getpoint "\nbase point: "))
  6. (setq b0 (getdist "\nwidth of table: "))
  7. (setq bl (getdist "\nwidth of line: "))
  8. (setq ln (getint "\nnumber of line: "))
  9. (if (or (= b "r") (= b "R")) (setq bl (* bl -1) b0 (* b0 -1)))
  10. (setq pt2 (list (+ (car pt1) b0) (cadr pt1)))
  11. (command "line" pt1 pt2 "")
  12. (command "line" pt1 (list (car pt1) (+ (cadr pt1) (* bl ln))) (list (car pt2) (+ (cadr pt1) (* bl ln))) pt2 "")
  13. (setq l 1)
  14. (while (<= l ln)
  15.     (command "line"  (list (car pt2) (+ (cadr pt2) bl)) (list (car pt1) (+ (cadr pt2) bl)) "")
  16.     (setq pt2 (list (car pt2) (+ (cadr pt2) bl)))
  17.     (setq l (+ l 1))
  18. )
  19. (setq cn (getint "\nnumber of column: "))
  20. (setq c0 1)
  21. (setq s (getstring "\nis equal the column? (Y/N) <N>: "))
  22. (if (or (= s "y") (= s "Y")) (progn
  23.         (setq pt3 pt1)
  24.         (setq cb (/ b0 cn))
  25.         (while (< c0 cn)
  26.           (command "line" (list (+(car pt3) cb) (cadr pt3)) (list (+ (car pt3) cb) (+ (cadr pt3) (* bl ln))) "")
  27.                      (setq pt3 (list (+ (car pt3) cb) (cadr pt3)))
  28.           (setq c0 (+ c0 1))
  29.         )))
  30. (if (or (= s "n") (= s "N") (= s ""))(while (< c0 cn)
  31.     (setq cb (getdist "\nwidth of column: "))
  32.     (if (or (= b "r") (= b "R")) (setq cb (* cb -1)))
  33.         (setq pt2 (list (+ (car pt1) cb) (cadr pt1)))
  34.     (command "line" pt2 (list (+ (car pt1) cb) (+ (cadr pt1) (* ln bl))) "")
  35.     (setq pt1 pt2)
  36.     (setq c0 (+ c0 1))
  37. ))
  38. (redraw)
  39. (cmdprompt)
  40.