home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p047 / 4.ddi / PM / 2PLT.LSP < prev    next >
Encoding:
Text File  |  1988-07-03  |  971 b   |  29 lines
  1. ;******PM\PM01.LSP******
  2.   (if (null df) (setq df 20))
  3. (defun C:2PLT ( )
  4.   (setq p1 (getpoint "enter p1:"))
  5.     (setq px (car p1) py (cadr p1))
  6.   (setq p2 (getpoint "enter p2:"))
  7.   (setq bl (getreal "enter bl<300>:"))
  8.     (if (null bl) (setq bl (* tb 300)))
  9.   (setq dx (- (car p2) px) dy (- (cadr p2) py))
  10.     (if (< dx dy) (2plt01) (2plt02))
  11. )
  12. (defun 2plt01 ( )
  13.   (setq n (fix (/ (- dy dx) bl)))
  14.   (setq n (1+ (abs n)))
  15.   (setq dx (* dx 0.5) dy (* (- dy (* bl n)) 0.5))
  16.   (setq px (+ px dx) py (+ py dy))
  17.   (setq p0 (list px py))
  18.   (command "pline" 
  19.      (setq p1 (list (- px (* df tb)) (- py (* 0.5 bl))))
  20.      (setq p1 (polar p1 (* pi 0.5) (* n bl)))
  21.      (setq p1 (polar p1 0 (* 2 df tb)))
  22.      (setq p1 (polar p1 (* pi -0.5) (* n bl))) "c")
  23.   (command "line" (setq p1 (polar p0 pi dx))
  24.      (polar p0 pi (* df tb)) "")
  25.   (command "line" (setq p2 (polar p0 0 dx))
  26.      (polar p0 0 (* df tb)) "")
  27.   (command "array" p1 p2 "" "r" n 1 bl)
  28. )
  29.