;huangsancai 2000
(defun get-utime ()
(* 86400 (getvar "tdusrtimer"))
)
;------------------------------
(defun c:sc()
(command "osnap" "off")
;-------------------------------
(command "layer" "c" 4 "" "" )
(setq bx (getint "\n 请输入欲删重叠层数[1]: "))
(if (= bx nil) (setq bx 1))
(setq q1 (getpoint "\n 请选择范围："))
(setq q2 (getcorner q1 ))
;-------------------------------
(setq shulian (ssget "c" q1 q2))
(if (= shulian nil) (progn (alert " SC提示:选择为空!") (exit)))
(setq shulian (itoa (sslength shulian)))
;------------------------------------------------------------
(setq r (getint "\n 缺省为1/请输入欲分范围均行列数[1~30]: "))
(if (= r nil) (setq r 1))
(setq t0 (get-utime))
(command "rectang" "w" r q1 q2 "")
(setq r1 (+ r 1))
(setq r2 (* r r1))
(setq r3 (- (* r r 2) 1))
(setq r4 (+ r 2))
(setq ax 0) ;计数器
;----------------------------------------
(setq x1 (/ (- (nth 0 q2) (nth 0 q1)) r))
(setq y1 (/ (- (nth 1 q1) (nth 1 q2)) r))
(setq v 0 )
(setq xlist nil klist nil)
(while (< v r1)
(setq y (polar q1 4.725 (* v y1)))
(setq klist (append klist (list y)))
(setq v1 0)
(while (< v1 r1)
(setq x (polar y 0 (* v1 x1)))
(setq xlist (append xlist (list x)))
(setq v1 (+ v1 1))
)
(setq v (+ v 1))
)
(setq i 0 zhen nil)
(while (< i r2)
(if (or (= i r) (= i (+ r (* 1 r1))) (= i (+ r (* 2 r1))) (= i (+ r (* 3 r1))) (= i (+ r (* 4 r1))) (= i (+ r (* 5 r1))) (= i (+ r (* 6 r1))) (= i (+ r (* 7 r1))) (= i (+ r (* 8 r1))) (= i (+ r (* 9 r1))) (= i (+ r (* 10 r1))) (= i (+ r (* 11 r1))) (= i (+ r (* 12 r1))) (= i (+ r (* 13 r1))) (= i (+ r (* 14 r1))) (= i (+ r (* 15 r1))) (= i (+ r (* 16 r1))) (= i (+ r (* 17 r1))) (= i (+ r (* 18 r1))) (= i (+ r (* 19 r1))) (= i (+ r (* 20 r1))) (= i (+ r (* 21 r1))) (= i (+ r (* 22 r1))) (= i (+ r (* 23 r1))) (= i (+ r (* 24 r1))) (= i (+ r (* 25 r1))) (= i (+ r (* 26 r1))) (= i (+ r (* 27 r1))) (= i (+ r (* 28 r1))))
(setq i (+ i 1))
(progn
(setq m (nth i xlist))
(setq o1 (nth (+ i r4) xlist))
(setq zhen (append zhen (list m )))
(setq zhen (append zhen (list o1)))
(setq i (+ i 1))
)
)
) ;得到正确坐标表
(command "erase" (entlast) "")
;-------------------------------------------
(setq dlist (list '(0 . "line") '(0 . "lwpolyline") '(0 . "mtext") '(0 . "text") '(0 . "point") '(0 . "insert") '(0 . "circle") '(0 . "hatch") '(0 . "polyline") '(0 . "arc") '(0 . "ellipse") ))
(setq v8 0)
