[编程交流] 用draworder过度杀戮，只是

(defun KGA_Block_DrawOrder (blkObj / sortArr sortTblObj)
 (if
   (and
     (= :vlax-true (vla-get-hasextensiondictionary blkObj))
     (setq sortTblObj (KGA_Sys_Apply 'vla-item (list (KGA_Data_ObjectExtDictGet blkObj) "ACAD_SORTENTS")))
   )
   (progn
     (vla-getfulldraworder sortTblObj 'sortArr :vlax-false)
     (mapcar 'vlax-variant-value (vlax-safearray->list sortArr)) ; Last is the top of the draworder.
   )
 )
)
(defun KGA_Conv_Pickset_To_ObjectList (ss / i ret)
 (if ss
   (repeat (setq i (sslength ss))
     (setq ret (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) ret))
   )
 )
)
(defun KGA_Data_ObjectExtDictGet (object)
 (if (= :vlax-true (vla-get-hasextensiondictionary object))
   (vla-getextensiondictionary object)
 )
)
; Make a zero based list of integers.
; With speed improvement based on Reini Urban's (std-%setnth).
; (KGA_List_IndexSeqMakeLength 7) => (0 1 2 3 4 5 6)
(defun KGA_List_IndexSeqMakeLength (len / ret)
 (repeat (rem len 4)
   (setq ret (cons (setq len (1- len)) ret))
 )
 (repeat (/ len 4)
   (setq ret
     (vl-list*
       (- len 4)
       (- len 3)
       (- len 2)
       (- len 1)
       ret
     )
   )
   (setq len (- len 4))
 )
 ret
)
(defun KGA_Sys_Apply (expr varLst / ret)
 (if (not (vl-catch-all-error-p (setq ret (vl-catch-all-apply expr varLst))))
   ret
 )
)
(defun KGA_Sys_ObjectOwner (obj)
 (vla-objectidtoobject (vla-get-database obj) (vla-get-ownerid obj))
)
(defun BKG_OverkillEqual  (ss seg fuzz
                           / N_Equal_P N_EqualPoints_P N_PointList
                             curveALst datLst delA_P idxLst n ordLst ptsLst
                         )
 (defun N_Equal_P (curveALst curveBLst) ; Format of lists: (staPt endPt objNme obj).
   (cond
     (
       (and
         (equal (car curveALst) (car curveBLst) fuzz)   ; Sta = Sta.
         (equal (cadr curveALst) (cadr curveBLst) fuzz) ; End = End.
       )
       (if (= "AcDbLine" (caddr curveALst) (caddr curveBLst))
         T
         (N_EqualPoints_P (cadddr curveALst) (cadddr curveBLst) nil)
       )
     )
     (
       (and
         (equal (car curveALst) (cadr curveBLst) fuzz)  ; Sta = End.
         (equal (cadr curveALst) (car curveBLst) fuzz)  ; End = Sta.
       )
       (if (= "AcDbLine" (caddr curveALst) (caddr curveBLst))
         T
         (N_EqualPoints_P (cadddr curveALst) (cadddr curveBLst) T)
       )
     )
   )
 )
 (defun N_EqualPoints_P (objA objB revB_P / ptsA ptsB)
   (setq ptsA (cond ((cadr (assoc objA ptsLst))) ((N_PointList objA))))
   (setq ptsB (cond ((cadr (assoc objB ptsLst))) ((N_PointList objB))))
   (if revB_P
     (equal ptsA (reverse ptsB) fuzz)
     (equal ptsA ptsB fuzz)
   )
 )
 (defun N_PointList (obj / pts size) ; Output does not include start and end point.
   (setq size (/ (vlax-curve-getdistatparam obj (vlax-curve-getendparam obj)) seg))
   (setq pts
     (mapcar
       '(lambda (idx) (vlax-curve-getpointatdist obj (* idx size)))
       idxLst
     )
   )
   (setq ptsLst (cons (list obj pts) ptsLst))
   pts
 )
 (setq idxLst (cdr (KGA_List_IndexSeqMakeLength seg))) ; Used by N_PointList.
 ;; For "_X" and "_A" sets the last created object is the first in datLst.
 ;; This is the top of the draworder if ordLst is nil.
 (setq datLst (KGA_Conv_Pickset_To_ObjectList ss))
 (setq ordLst (reverse (KGA_Block_DrawOrder (KGA_Sys_ObjectOwner (car datLst))))) ; First is the top of the draworder.
 (setq datLst
   (vl-remove
     nil
     (mapcar
       '(lambda (obj / onm)
         (if
           (and
             (vlax-write-enabled-p obj)
             (vl-position
               (setq onm (vla-get-objectname obj))
               '("AcDb2dPolyline" "AcDbArc" "AcDbCircle" "AcDbEllipse" "AcDbLine" "AcDbPolyline" "AcDbSpline")
             )
           )
           (list
             (vlax-curve-getstartpoint obj)
             (vlax-curve-getendpoint obj)
             onm
             obj
           )
         )
       )
       datLst
     )
   )
 )
 (setq n 0)
 (while (cadr datLst)
   (setq delA_P nil)
   (setq curveALst (car datLst))
   (foreach curveBLst (setq datLst (cdr datLst))
     (if (N_Equal_P curveALst curveBLst)
       (if
         (or
           (not ordLst)
           (< (vl-position (cadddr curveALst) ordLst) (vl-position (cadddr curveBLst) ordLst))
         )
         (progn
           (setq datLst (vl-remove curveBLst datLst))
           (vla-delete (cadddr curveBLst))
           (setq n (1+ n))
         )
         (setq delA_P T) ; Don't delete curve A just yet.
       )
     )
   )
   (if delA_P
     (progn
       (vla-delete (cadddr curveALst))
       (setq n (1+ n))
     )
   )
 )
 n ; Return total deleted entities.
)