[编程交流] 选择所有要删除的块

;;----------------=={ Entity to Point List }==----------------;;
;;                                                            ;;
;;  Returns a list of points describing or approximating the  ;;
;;  supplied entity, else nil if the entity is not supported. ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  ent - Entity for which to return Point List.              ;;
;;------------------------------------------------------------;;
;;  Returns:  List of Points describing/approximating entity  ;;
;;------------------------------------------------------------;;
(defun LM:Entity->PointList ( ent / der di1 di2 di3 elst fun inc lst par rad )
   (setq elst (entget ent))
   (cond
       (   (eq "POINT" (cdr (assoc 0 elst)))
           (list (cdr (assoc 10 elst)))
       )
       (   (eq "LINE" (cdr (assoc 0 elst)))
           (list (cdr (assoc 10 elst)) (cdr (assoc 11 elst)))
       )
       (   (member (cdr (assoc 0 elst)) '("CIRCLE" "ARC"))
           (setq di1 0.0
                 di2 (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent))
                 inc (/ di2 (1+ (fix (* 35.0 (/ di2 (cdr (assoc 40 elst)) (+ pi pi))))))
                 fun (if (vlax-curve-isclosed ent) < <=)
           )
           (while (fun di1 di2)
               (setq lst (cons (vlax-curve-getpointatdist ent di1) lst)
                     di1 (+ di1 inc)
               )
           )
           lst
       )
       (   (or (eq (cdr (assoc 0 elst)) "LWPOLYLINE")
               (and (eq (cdr (assoc 0 elst)) "POLYLINE") (zerop (logand (cdr (assoc 70 elst)) 80)))
           )
           (setq par 0)
           (repeat (fix (1+ (vlax-curve-getendparam ent)))
               (if (setq der (vlax-curve-getsecondderiv ent par))
                   (if (equal der '(0.0 0.0 0.0) 1e-
                       (setq lst (cons (vlax-curve-getpointatparam ent par) lst))
                       (if (setq rad (distance '(0.0 0.0) (vlax-curve-getfirstderiv ent par))
                                 di1 (vlax-curve-getdistatparam ent par)
                                 di2 (vlax-curve-getdistatparam ent (1+ par))
                           )
                           (progn
                               (setq inc (/ (- di2 di1) (1+ (fix (* 35.0 (/ (- di2 di1) rad (+ pi pi)))))))
                               (while (< di1 di2)
                                   (setq lst (cons (vlax-curve-getpointatdist ent di1) lst)
                                         di1 (+ di1 inc)
                                   )
                               )
                           )
                       )
                   )
               )
               (setq par (1+ par))
           )
           (if (or (vlax-curve-isclosed ent) (equal '(0.0 0.0 0.0) der 1e-)
               lst
               (cons (vlax-curve-getendpoint ent) lst)
           )
       )
       (   (eq (cdr (assoc 0 elst)) "ELLIPSE")
           (setq di1 (vlax-curve-getdistatparam ent (vlax-curve-getstartparam ent))
                 di2 (vlax-curve-getdistatparam ent (vlax-curve-getendparam   ent))
                 di3 (* di2 (/ (+ pi pi) (abs (- (vlax-curve-getendparam ent) (vlax-curve-getstartparam ent)))))
           )
           (while (< di1 di2)
               (setq lst (cons (vlax-curve-getpointatdist ent di1) lst)
                     der (distance '(0.0 0.0) (vlax-curve-getsecondderiv ent (vlax-curve-getparamatdist ent di1)))
                     di1 (+ di1 (/ di3 (1+ (fix (/ 35.0 (/ di3 der (+ pi pi)))))))
               )
           )
           (if (vlax-curve-isclosed ent)
               lst
               (cons (vlax-curve-getendpoint ent) lst)
           )
       )
       (   (eq (cdr (assoc 0 elst)) "SPLINE")
           (setq di1 (vlax-curve-getdistatparam ent (vlax-curve-getstartparam ent))
                 di2 (vlax-curve-getdistatparam ent (vlax-curve-getendparam   ent))
                 inc (/ di2 25.0)
           )
           (while (< di1 di2)
               (setq lst (cons (vlax-curve-getpointatdist ent di1) lst)
                     der (/ (distance '(0.0 0.0) (vlax-curve-getsecondderiv ent (vlax-curve-getparamatdist ent di1))) inc)
                     di1 (+ di1 (if (equal 0.0 der 1e-10) inc (min inc (/ 1.0 der (* 10. inc)))))
               )
           )
           (if (vlax-curve-isclosed ent)
               lst
               (cons (vlax-curve-getendpoint ent) lst)
           )
       )
   )
)
(defun remove:duplicate (l m / a n)
 (while l
   (setq a (car l))
   (setq l (vl-remove-if
      '(lambda (x)
         (if (not m)
           (eq x a)
         (and (eq (car x) (car a))
              (eq (cadr x) (cadr a))
              (eq (caddr x) (caddr a))
         ))
       )
      l
    )
   )
   (setq n (cons a n))
 )
 (reverse n)
)
(defun c:test (/ a b i i1 obj lst sel)
 (if (setq a (ssget '((0 . "*line,arc,circle"))))
   (progn
     (setq sel (ssadd))
     (repeat (setq i (sslength a))
(setq obj (ssname a (setq i (1- i))))
(setq lst (remove:duplicate (LM:Entity->PointList obj) t))
(if (setq b (ssget "_F" lst '((0 . "insert"))))
  (repeat (setq i1 (sslength b))
    (ssadd (ssname b (setq i1 (1- i1))) sel)
  )
)
     )
     (sssetfirst nil sel)
   )
 )
 (princ)
)

(vl-load-com)
(defun c:slbl2 (/ _kpblc-conv-selset-to-ename pl selset res prec)
 (defun _kpblc-conv-selset-to-ename (selset / tab item)
   (cond
     ((not selset) nil)
     ((= (type selset) 'pickset)
      (repeat (setq tab  nil
                    item (sslength selset)
                    ) ;_ end setq
        (setq tab (cons (ssname selset (setq item (1- item))) tab))
        ) ;_ end repeat
      )
     ) ;_ end of cond
   ) ;_ end of defun
 (if (and (= (type (setq pl (vl-catch-all-apply
                              (function
                                (lambda ()
                                  (car (entsel "\nSelect LWPolyline <Cancel> : "))
                                  ) ;_ end of lambda
                                ) ;_ end of function
                              ) ;_ end of vl-catch-all-apply
                         ) ;_ end of setq
                   ) ;_ end of type
             'ename
             ) ;_ end of =
          (setq selset (_kpblc-conv-selset-to-ename (ssget "_X" (list '(0 . "INSERT") (assoc 410 (entget pl))))))
          ) ;_ end of and
   (progn
     (setq prec   1e-1
           pl     (vlax-ename->vla-object pl)
           selset (vl-remove-if-not
                    (function
                      (lambda (x / pt pt_closest)
                        (setq pt         (cdr (assoc 10 (entget x)))
                              pt_closest (vlax-curve-getclosestpointto pl pt)
                              ) ;_ end of setq
                        (< (distance pt pt_closest) prec)
                        ) ;_ end of lambda
                      ) ;_ end of function
                    selset
                    ) ;_ end of vl-remove-if-not
           res    (ssadd)
           ) ;_ end of setq
     (foreach item selset (ssadd item res))
     (if (> (sslength res) 0)
       (sssetfirst res res)
       ) ;_ end of if
     ) ;_ end of progn
   ) ;_ end of if
 ) ;_ end of defun