求助：如何清楚重复的块（0.05mm范围内）

soonsos

    如何清楚重复的块（0.05mm范围内），下面是本人在本论坛找到的lsp程序，但是在cad2008里运行后出现：“ec ; 错误: 参数类型错误: lselsetp nil”。    不知道是什么原因。哪位大神有调试好的程序给放个上来。


下面在本论坛找到的代码，但是不能运行，也就是说不能检验是否可以清除重复块：
(defun c:ec() (command "undo" "be")
(setvar "cmdecho" 0)
  (command "zoom" "e")
  (command "layer" "m" "不确定图层" "")
  (VL-LOAD-COM)
  (setq ss(ssget "x"))
  (setq sslen(sslength ss))
  (setq i 0)
  (repeat sslen
    (setq ent(ssname ss i))
    (setq VOBJ (vlax-ename->vla-object ent))
    (setq Y_N(vlax-erased-p VOBJ))
    (if (= Y_N nil)
      (progn
(setq info(entget ent)
       leixing(cdr(assoc 0 info))
       layer(cdr(assoc 8 info))
       jidian(cdr(assoc 10 info))
       ID (vla-get-handle VOBJ)
  )
( vla-getboundingbox VOBJ 'maxzb 'minzb)
(setq maxzb (vlax-safearray->list maxzb))
        (setq minzb (vlax-safearray->list minzb))

(setq ss2(ssget "c" maxzb minzb (list (cons 0 leixing) (cons 8 layer))))
(ssdel ent ss2)
(if (/= ss2 nil)
   (progn
   (setq sslen2(sslength ss2))
   (setq j 0)
   (repeat sslen2
     (setq ent2(ssname ss2 j)
    vobj2(vlax-ename->vla-object ent2)
    id2(vla-get-handle VOBJ2)
    )
     (if (> (16to10 id2) (16to10 id))
       (progn
  (setq info2(entget ent2)
             leixing2(cdr(assoc 0 info2))
            layer2(cdr(assoc 8 info2))
            jidian2(cdr(assoc 10 info2))
        )
  (setq dist(distance jidian2 jidian))

  (if (= leixing2 leixing)
    (if (= layer2 layer)
      (if (< dist 0.05)
        (progn
        ;块类型
   (if (= leixing "INSERT")
     (progn
   (if (equal (assoc 2 info) (assoc 2 info2))
      (command "erase" ent2 "")
     )
   )
     )
        ;圆类型
        (if (= leixing "CIRCLE")
   (if (equal (assoc 40 info) (assoc 40 info2))
     (command "erase" ent2 "")
     )
   )
        ;线类型
        (if (or (= leixing  "POLYLINE") (= leixing "LWPOLYLINE"))
                 (progn
                 (setq vtx (vla-get-Coordinates vobj))
                 (setq vtxlst (vlax-safearray->list (vlax-variant-value vtx)))
   (setq vtx2 (vla-get-Coordinates vobj2))
                 (setq vtxlst2 (vlax-safearray->list (vlax-variant-value vtx2)))
   (if (= (length vtxlst) (length vtxlst2))
     (progn
                 (setq k 0)
   (setq flat 0)
                 (repeat (/ (length vtxlst) 2)
                         (setq ptlst (list (nth k vtxlst) (nth (1+ k) vtxlst)))
           (setq ptlst2(list (nth k vtxlst2) (nth (1+ k) vtxlst2)))
       (if (> (distance ptlst ptlst2) 0.05)
      (setq flat 1)
                           (setq k (+ k 2))
      )
     )
     (if (= flat 0)
       (command "erase" ent2 "")
       (command "change" ent2 "" "p" "la" "不确定图层" "")
       )
     )
     )
   )
   )
        ;直线类型
        (if (= leixing "LINE")
   (progn
     (setq point1(cdr(assoc 11 info))
    point2(cdr(assoc 11 info2))
    )

   (if (< (distance point1 point2) 0.05)
     (command "erase" ent2 "")
     )
   ))
         ;文本类型
        (if (= leixing "TEXT")
   (if (equal (assoc 1 info) (assoc 1 info2))
     (command "erase" ent2 "")
     )
   )
        ;其他类型
         (if (and (/= leixing "INSERT")(/= leixing "CIRCLE")(/= leixing  "POLYLINE") (/= leixing "LWPOLYLINE")(/= leixing "TEXT")(/= leixing "LINE"))
    (command "erase" ent2 "")
    )
        )
  );基点距离小于0.05
);同层
      );同型
  );progn
       );ent2创建时间迟于ent，ID2大于ID。
       (setq j(1+ j))
      );repeat ss2
   );progn
   );if
);progn
      (setq ss2 null)
      );ent在
     (setq i(1+ i))
    );repeat ss
  (setvar "cmdecho" 0)
  (command "undo" "e")
  (princ "清理完毕！")
  (alert "清理完毕！")
  (princ)
  )


;16进制转换位10进制
(defun 16to10(str / )
   (setq len(strlen str))
   (setq weizhi 1)
   (setq num10 0)
   (repeat len
     (setq zifu (substr str weizhi 1))
     (cond
     ((and (>= (ascii (strcase zifu)) 65) (<= (ascii (strcase zifu)) 70)) (setq zifu (- (ascii (strcase zifu)) 55)))
     ((and (>= (ascii zifu) 48) (<= (ascii zifu) 57)) (setq zifu (atoi zifu)))
     )
     (setq num10 (+ (* num10 16) zifu))
     (setq weizhi (1+ weizhi))
     )
     num10
   )

(defun c:ec()
(command "undo" "be")
(setvar "cmdecho" 0)
  (command "zoom" "e")
  (command "layer" "m" "不确定图层" "")
  (VL-LOAD-COM)
  (setq ss(ssget "x"))
  (setq sslen(sslength ss))
  (setq i 0)
  (repeat sslen
    (setq ent(ssname ss i))
    (setq VOBJ (vlax-ename->vla-object ent))
    (setq Y_N(vlax-erased-p VOBJ))
    (if (= Y_N nil)
      (progn
(setq info(entget ent)
       leixing(cdr(assoc 0 info))
       layer(cdr(assoc 8 info))
       jidian(cdr(assoc 10 info))
       ID (vla-get-handle VOBJ)
  )
( vla-getboundingbox VOBJ 'maxzb 'minzb)
(setq maxzb (vlax-safearray->list maxzb))
        (setq minzb (vlax-safearray->list minzb))

(setq ss2(ssget "c" maxzb minzb (list (cons 0 leixing) (cons 8 layer))))
(ssdel ent ss2)
(if (/= ss2 nil)
   (progn
   (setq sslen2(sslength ss2))
   (setq j 0)
   (repeat sslen2
     (setq ent2(ssname ss2 j)
    vobj2(vlax-ename->vla-object ent2)
    id2(vla-get-handle VOBJ2)
    )
     (if (> (16to10 id2) (16to10 id))
       (progn
  (setq info2(entget ent2)
             leixing2(cdr(assoc 0 info2))
            layer2(cdr(assoc 8 info2))
            jidian2(cdr(assoc 10 info2))
        )
  (setq dist(distance jidian2 jidian))

  (if (= leixing2 leixing)
    (if (= layer2 layer)
      (if (< dist 0.05)
        (progn
        ;块类型
   (if (= leixing "INSERT")
     (progn
   (if (equal (assoc 2 info) (assoc 2 info2))
      (command "erase" ent2 "")
     )
   )
     )
        ;圆类型
        (if (= leixing "CIRCLE")
   (if (equal (assoc 40 info) (assoc 40 info2))
     (command "erase" ent2 "")
     )
   )
        ;线类型
        (if (or (= leixing  "POLYLINE") (= leixing "LWPOLYLINE"))
                 (progn
                 (setq vtx (vla-get-Coordinates vobj))
                 (setq vtxlst (vlax-safearray->list (vlax-variant-value vtx)))
   (setq vtx2 (vla-get-Coordinates vobj2))
                 (setq vtxlst2 (vlax-safearray->list (vlax-variant-value vtx2)))
   (if (= (length vtxlst) (length vtxlst2))
     (progn
                 (setq k 0)
   (setq flat 0)
                 (repeat (/ (length vtxlst) 2)
                         (setq ptlst (list (nth k vtxlst) (nth (1+ k) vtxlst)))
           (setq ptlst2(list (nth k vtxlst2) (nth (1+ k) vtxlst2)))
       (if (> (distance ptlst ptlst2) 0.05)
      (setq flat 1)
                           (setq k (+ k 2))
      )
     )
     (if (= flat 0)
       (command "erase" ent2 "")
       (command "change" ent2 "" "p" "la" "不确定图层" "")
       )
     )
     )
   )
   )
        ;直线类型
        (if (= leixing "LINE")
   (progn
     (setq point1(cdr(assoc 11 info))
    point2(cdr(assoc 11 info2))
    )

   (if (< (distance point1 point2) 0.05)
     (command "erase" ent2 "")
     )
   ))
         ;文本类型
        (if (= leixing "TEXT")
   (if (equal (assoc 1 info) (assoc 1 info2))
     (command "erase" ent2 "")
     )
   )
        ;其他类型
         (if (and (/= leixing "INSERT")(/= leixing "CIRCLE")(/= leixing  "POLYLINE") (/= leixing "LWPOLYLINE")(/= leixing "TEXT")(/= leixing "LINE"))
    (command "erase" ent2 "")
    )
        )
  );基点距离小于0.05
);同层
      );同型
  );progn
       );ent2创建时间迟于ent，ID2大于ID。
       (setq j(1+ j))
      );repeat ss2
   );progn
   );if
);progn
      (setq ss2 null)
      );ent在
     (setq i(1+ i))
    );repeat ss
  (setvar "cmdecho" 0)
  (command "undo" "e")
  (princ "清理完毕！")
  (alert "清理完毕！")
  (princ)
  )


;16进制转换位10进制
(defun 16to10(str / )
   (setq len(strlen str))
   (setq weizhi 1)
   (setq num10 0)
   (repeat len
     (setq zifu (substr str weizhi 1))
     (cond
     ((and (>= (ascii (strcase zifu)) 65) (<= (ascii (strcase zifu)) 70)) (setq zifu (- (ascii (strcase zifu)) 55)))
     ((and (>= (ascii zifu) 48) (<= (ascii zifu) 57)) (setq zifu (atoi zifu)))
     )
     (setq num10 (+ (* num10 16) zifu))
     (setq weizhi (1+ weizhi))
     )
     num10
   )

liuxu042

自己写一个实现就是，不用管别人的代码

soonsos

怎么写呀？你有吗？楼上的，发个上来。我需要这种程序很实用的！