home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p047 / 4.ddi / ZT / RZBWG.LSP < prev    next >
Encoding:
Text File  |  1989-09-19  |  3.0 KB  |  101 lines
  1. ;******ZT\RZBWG.LSP******
  2. (if (null tb0) (setq tb0 500))
  3. (if (null mmm) (setq mmm "m"))
  4. (if (null tb) (setq tb 0.5))
  5. ;-----------
  6. (defun C:ZBWXY ( )
  7.   (if (/= (getvar "clayer") "cc") (command "layer" "m" "cc" ""))
  8.   (setq p0 (getpoint "enter P0:"))
  9.   (setq p0x (car p0) p0y (cadr p0))
  10.   (setq dl (getreal "enter WGJJ dl <100.0>:"))
  11.   (if (null dl) (setq dl 100.0))
  12.   (setq m (getint "enter WGS m <10>:"))
  13.   (if (null m) (setq m 10))
  14.   (setq n (getint "enter WGS n <5>:"))
  15.   (if (null n) (setq m 5))
  16.   (command "insert" "fa/szx" p0 (* 300 tb) "" 0.0)
  17.   (command "array" "l" "" "r" (1+ n) (1+ m) dl dl)
  18.   (setq pt (list (+ p0x (* -300 tb)) (+ p0y (* -150 tb))))
  19.   (setq k 0 adl p0y)
  20.   (while (<= k n)
  21.     (command "text" "r" (polar pt (* 0.5 pi) (* k dl))
  22.       (* 300 tb) 0.0 (strcat "X" (rtos adl 2 0)))
  23.     (setq k (1+ k))
  24.     (setq adl (+ adl dl))
  25.   )
  26.   (setq pt (list (+ p0x (* -150 tb)) (+ p0y (* -300 tb))))
  27.   (setq k 0 adl p0x)
  28.   (while (<= k m)
  29.     (command "text" (polar pt 0.0 (* k dl))
  30.       (* 300 tb) -90 (strcat "Y" (rtos adl 2 0)))
  31.     (setq k (1+ k))
  32.     (setq adl (+ adl dl))
  33.   )
  34. )
  35. ;----------
  36. (defun C:WZBXY ( )
  37.   (wzb01)
  38.   (setq xa "X " yb "Y ")
  39.   (wzb02)
  40. )
  41. (defun C:WZBAB ( )
  42.   (wzb01)
  43.   (setq xa "A " yb "B ")
  44.   (wzb02)
  45. )
  46. ;-------
  47. (defun wzb01 ( )
  48.   (setq p1 (getpoint "enter P1:"))
  49.   (setq p1x (car p1) p1y (cadr p1))
  50.   (setq p2 (getpoint "enter P2:"))
  51.   (setvar "elevation" 0.0)
  52.   (setvar "thickness" 0.0)
  53.   (if (/= (getvar "clayer") "cc") (command "layer" "m" "cc" ""))
  54.   (if (> (car p2) p1x) 
  55.     (command "pline" p1 p2 (polar p2 0.0 (* 1750 tb)) "")
  56.     (command "pline" p1 p2 (polar p2 pi (* 1750 tb)) ""))
  57.   (if (or (= mmm "mm") (= mmm "MM"))
  58.      (setq p1x (* 0.001 p1x) p1y (* 0.001 p1y)))
  59.   (setq p1x (rtos p1x 2 2))
  60.   (setq p1y (rtos p1y 2 2))
  61. )
  62. (defun wzb02 ( )
  63.   (setq p2x (car p2) p2y (cadr p2))
  64.   (if (> p2x (car p1))
  65. (progn
  66.   (command "text" (list (+ (* 50 tb) p2x) (+ (* 75 tb) p2y))
  67.     (* 250 tb) 0.0 (strcat xa p1y))
  68.   (command "text" (list (+ (* 50 tb) p2x) (+ (* -350 tb) p2y))
  69.     (* 250 tb) 0.0 (strcat yb p1x)))
  70. (progn
  71.   (command "text" "r" (list (+ (* -50 tb) p2x) (+ (* 75 tb) p2y))
  72.     (* 250 tb) 0.0 (strcat xa p1y))
  73.   (command "text" "r" (list (+ (* -50 tb) p2x) (+ (* -350 tb) p2y))
  74.     (* 250 tb) 0.0  (strcat yb p1x)))
  75.   )
  76. )
  77. ;**************
  78. (defun C:WZBAB1 ( )
  79.   (setq p1 (getpoint "enter P1:"))
  80.   (setq p1x (car p1) p1y (cadr p1))
  81.   (wzb01) (wzb0)
  82.   (command "text" "r" (polar p2 (* 0.25 pi) (* 85 tb)) (* 250 tb)
  83.     0.0 (strcat "A " p1y))
  84.   (command "text" "r" (polar p2 (* -0.445 pi) (* 335 tb)) (* 250 tb)
  85.     0.0 (strcat "B " p1x))
  86. )
  87. (defun wzb03 ( )
  88.   (setq p1x (- p1x (car rpt)))
  89.   (setq p1y (- p1y (cadr rpt)))
  90.   (setq np1x (- (* p1x (cos af)) (* p1y (sin af))))
  91.   (setq np1y (+ (* p1x (sin af)) (* p1y (cos af))))
  92.   (setq p1x (+ np1x (car rpt)))
  93.   (setq p1y (+ np1y (cadr rpt)))
  94. )
  95. ;--------
  96. (defun wzb10 ( )
  97.   (setq rpt (getpoint "rotate point:"))
  98.   (setq af (entget (car (entsel "select block zbz:"))))
  99.   (setq af (* -1 (cdr (assoc 50 af))))
  100. )
  101.