home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p047 / 4.ddi / 3D / TJ.LSP < prev    next >
Encoding:
Text File  |  1991-09-19  |  2.0 KB  |  71 lines
  1. ;****** FA\TJ.LSP ****** 10-19-89 CD
  2. (if (= mmm "M") (setq mmms "\n !mmm=M,") (setq mmms "\n !mmm=MM,"))
  3. ;------------
  4. (defun C:TJ ( )
  5.   (setvar "osmode" 0)
  6.   (setq wcy 1)
  7.   (while wcy
  8.     (setq mode (getint "\n 1.tjx0/2.2dtj/3.3dtj 
  9.       <or RETRUN for none>:"))
  10.     (if (= mode nil) (setq wcy nil))
  11.     (if (= mode 1) (pl0))
  12.     (if (= mode 2) (2dtj))
  13.     (if (= mode 3) (3dtj))
  14.   )
  15. )
  16. ;-----------
  17. (defun pl0 ( )
  18.   (setq p1 (getpoint "Start point:"))
  19.   (setq wxr 1 ss (ssadd))
  20.   (while wxr
  21.    (setq p2 (getpoint "\n next point <or RETRUN for continue>:" p1))
  22.     (if p2
  23.       (progn (command "pline" p1 p2 "")
  24.         (setq ss (ssadd (entlast) ss)) (setq p1 p2))
  25.       (setq wxr nil)
  26.     )
  27.   )
  28.   (command "pedit" p1 "j" ss "" "")
  29. ; (setq ss (entlast))
  30. )
  31. ;-----------
  32. (defun 2dtj ( / n k)
  33.   (setq nss (entsel "\n Select Polyline:"))
  34. ; (if nss (setq p1 (cadr nss)) (pl0))
  35.   (if nss (setq p1 (cadr nss)))
  36.   (setq n (getint "enter int n <5>:"))
  37.   (if (null n) (setq n 5))
  38.   (setq dl (getreal (strcat mmms "enter dl <300>:")))
  39.   (if (null dl) (setq dl 300.0))
  40.   (setq pt (getpoint "Side to offset?"))
  41.   (setq k 1)
  42.   (while (< k n)
  43.     (command "offset" (* k dl) p1 pt "")
  44.     (setq k (1+ k))
  45.   )
  46. )
  47. ;-----------
  48. (defun 3dtj ( / n k)
  49.   (setq ss (entsel "\n Select Polyline:"))
  50. ; (if ss (setq p1 (cadr ss)) (pl0))
  51.   (if ss (setq p1 (cadr ss)))
  52.   (setq n (getint "enter int n <5>:"))
  53.   (if (null n) (setq n 5))
  54.   (setq dl (getreal (strcat mmms "enter dl <300>:")))
  55.   (if (null dl) (setq dl 300.0))
  56.   (setq dh (getreal (strcat mmms "enter dh <150>:")))
  57.   (if (null dh) (setq dh 150.0))
  58.   (setq ss (entget (car ss)))
  59. ; (setq ss (subst (cons 39 dh) (assoc 39 ss) ss))
  60.   (if (= (assoc 39 ss) nil) (setq ss (cons (cons 39 dh) ss))
  61.     (setq ss (subst (cons 39 dh) (assoc 39 ss) ss)))
  62.   (entmod ss)
  63.   (setq pt (getpoint "Side to offset?"))
  64.   (setq k 1)
  65.   (while (< k n)
  66.     (command "offset" (* k dl) p1 pt "")
  67.     (command "move" "l" "" (list 0 0 (* k dh)) "")
  68.     (setq k (1+ k))
  69.   )
  70. )
  71.