CAD去重实用脚本：LSP编程实现

;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)