Delete double lines (CONTROLED)

Hello all,

I got a large drawing with alot of double lines on different layers.

Now i know about the OVERKILL command, but this seems to delete one of the two lines randomly...

Is there a methode to delete all double lines, but ALWAYS keep the 'upper' one?

Use OVERKILL-MR posted here :

https://www.theswamp.org/index.php?topic=49862.0 (you have to be logged in)

or posted here on cadtutor :

http://www.cadtutor.net/forum/showthread.php?83657-I-need-overkill-and-ncopy-!please-help-me!/page4&p=#34

Hey MArko_ribar,

Thats for the reply, but OVERKILL-MR still seems to delete one of the lines randomly, it does not keep the upper one!

Hey MArko_ribar,

 

Thats for the reply, but OVERKILL-MR still seems to delete one of the lines randomly, it does not keep the upper one!

Here, try this :

(defun OVERKILL-MR ( ss seg fuzz / adoc *error* nolst i k sss curve m n ent entl pt ptlst ii zz kk iii curvetst ptt pttlst curves )

 (vl-load-com)
 (setq adoc (vla-get-activedocument (vlax-get-acad-object)))

 (defun *error* ( msg )
   (vla-endundomark adoc)
   (if msg (prompt msg))
   (princ)
 )

 (defun nolst ( st en / lst )
   (repeat (- en st)
     (setq st (1+ st))
     (setq lst (cons st lst))
   )
   (reverse lst)
 )

 (vla-startundomark adoc)
 (setq i -1)
 (setq k 0)
 (setq kk 0)
 (setq sss (ssadd))
 (if ss
   (progn
     (while (setq curve (ssname ss (setq i (1+ i))))
       (setq m -1.0)
       (repeat (+ seg 1)
         (setq pt (vlax-curve-getpointatparam curve (+ (vlax-curve-getstartparam curve) (* (setq m (1+ m)) (/ (- (vlax-curve-getendparam curve) (vlax-curve-getstartparam curve)) (float seg))))))
         (if (not (eq m seg))
           (setq ptlst (cons pt ptlst))
           (setq ptlst (cons (vlax-curve-getendpoint curve) ptlst))
         )
       )
       (setq ptlst (vl-remove nil ptlst))
       (setq pt (car ptlst))
       (if (vl-every (function (lambda ( x ) (equal x pt fuzz))) ptlst)
         (progn
           (entdel curve)
           (setq k (1+ k))
         )
         (ssadd curve sss)
       )
       (setq ptlst nil)
     )
     (setq ii -1)
     (setq zz -1)
     (repeat (setq n (sslength sss))
       (setq ent (ssname sss (setq n (1- n))))
       (setq entl (cons ent entl))
     )
     (setq entl (vl-sort entl (function (lambda ( a b ) (> (vlax-curve-getdistatparam a (vlax-curve-getendparam a)) (vlax-curve-getdistatparam b (vlax-curve-getendparam b)))))))
     (setq sss (ssadd))
     (foreach ent entl
       (ssadd ent sss)
     )
     (if (/= (sslength sss) 0)
       (progn
         (while (setq curve (ssname sss (setq ii (1+ ii))))
           (foreach iii (vl-remove ii (if (null (nolst zz (if sss (1- (sslength sss)) zz))) (list ii) (nolst zz (if sss (1- (sslength sss)) zz))))
             (setq curvetst (ssname sss iii))
             (setq m -1.0)
             (repeat (+ seg 1)
               (setq pt (vlax-curve-getpointatparam curvetst (+ (vlax-curve-getstartparam curvetst) (* (setq m (1+ m)) (/ (- (vlax-curve-getendparam curvetst) (vlax-curve-getstartparam curvetst)) (float seg))))))
               (if (not (eq m seg))
                 (setq pttlst (cons pt pttlst))
                 (setq pttlst (cons (vlax-curve-getendpoint curve) pttlst))
               )
             )
             (foreach ptt pttlst
               (setq ptt (vlax-curve-getclosestpointto curve ptt))
               (setq ptlst (cons ptt ptlst))
             )
             (setq ptlst (reverse ptlst))
             (if (and 
                   (vl-every (function (lambda ( a b ) (equal a b fuzz))) ptlst pttlst)
                   (or 
                     (if (setq pt (vlax-curve-getpointatparam curvetst (vlax-curve-getparamatpoint curvetst (vlax-curve-getclosestpointto curvetst (vlax-curve-getpointatparam curve (+ (vlax-curve-getstartparam curve) 1e-10)))))) ;; pt is either startpoint of curvetst or some point on curvetst
                       (if (not (equal (distance pt (vlax-curve-getstartpoint curve)) 0.0 fuzz))
                         ;; startpoint of curve is not equal to startpoint of curvetst
                         (if (setq pt (vlax-curve-getpointatparam curve (vlax-curve-getparamatpoint curve (vlax-curve-getclosestpointto curve (vlax-curve-getstartpoint curvetst))))) ;; pt is either startpoint of curve or some point on curve
                           (equal (distance pt (vlax-curve-getstartpoint curvetst)) 0.0 fuzz) ;; startpoint of curvetst "closely belongs" to curve and is not equal to startpoint of curve as it belongs to then statement of if function that checked that startpoint of curve is not equal to startpoint of curvetst
                         )
                         (or
                           (equal (distance (vlax-curve-getstartpoint curve) (vlax-curve-getstartpoint curvetst)) 0.0 fuzz) ;; startpoint of curve is equal to startpoint of curvetst
                           (equal (distance (vlax-curve-getstartpoint curve) (vlax-curve-getendpoint curvetst)) 0.0 fuzz) ;; startpoint of curve is equal to endpoint of curvetst
                           (equal (distance (vlax-curve-getendpoint curve) (vlax-curve-getstartpoint curvetst)) 0.0 fuzz) ;; endpoint of curve is equal to startpoint of curvetst
                           (equal (distance (vlax-curve-getendpoint curve) (vlax-curve-getendpoint curvetst)) 0.0 fuzz) ;; endpoint of curve is equal to endpoint of curvetst
                         ) ;; or checks coincidence of start/end points of curve and curvetst and for cases of reversed curves
                       )
                     )
                     (if (setq pt (vlax-curve-getpointatparam curvetst (vlax-curve-getparamatpoint curvetst (vlax-curve-getclosestpointto curvetst (vlax-curve-getpointatparam curve (- (vlax-curve-getendparam curve) 1e-10)))))) ;; pt is either endpoint of curvetst or some point on curvetst
                       (if (not (equal (distance pt (vlax-curve-getendpoint curvetst)) 0.0 fuzz))
                         ;; endpoint of curve is not equal to endpoint of curvetst
                         (if (setq pt (vlax-curve-getpointatparam curve (vlax-curve-getparamatpoint curve (vlax-curve-getclosestpointto curve (vlax-curve-getendpoint curvetst))))) ;; pt is either endpoint of curve or some point on curve
                           (equal (distance pt (vlax-curve-getstartpoint curvetst)) 0.0 fuzz) ;; endpoint of curvetst "closely belongs" to curve and is not equal to endpoint of curve as it belongs to then statement of if function that checked that endpoint of curve is not equal to endpoint of curvetst
                         )
                         (or
                           (equal (distance (vlax-curve-getstartpoint curve) (vlax-curve-getstartpoint curvetst)) 0.0 fuzz) ;; startpoint of curve is equal to startpoint of curvetst
                           (equal (distance (vlax-curve-getstartpoint curve) (vlax-curve-getendpoint curvetst)) 0.0 fuzz) ;; startpoint of curve is equal to endpoint of curvetst
                           (equal (distance (vlax-curve-getendpoint curve) (vlax-curve-getstartpoint curvetst)) 0.0 fuzz) ;; endpoint of curve is equal to startpoint of curvetst
                           (equal (distance (vlax-curve-getendpoint curve) (vlax-curve-getendpoint curvetst)) 0.0 fuzz) ;; endpoint of curve is equal to endpoint of curvetst
                         ) ;; or checks coincidence of start/end points of curve and curvetst and for cases of reversed curves
                       )
                     )
                   ) ;; curvetst is "inside" or equal to curve
                 )
               (if (not (vl-position curve curves))
                 (setq curves (cons curvetst curves))
               )
             )
             (setq ptlst nil pttlst nil)
           )
         )
         (foreach curve curves
           (setq kk (1+ kk))
           (entdel curve)
         )
       )
     )
   )
 )
 (*error* nil)
 (sssetfirst nil sss)
)

(defun getOrder ( / doc spc dic sort order )

 (vl-load-com)

 (setq doc (vla-get-activeDocument (vlax-get-acad-object))
       spc (if (zerop (vla-get-activespace doc))
             (if (= (vla-get-mspace doc) :vlax-true)
               (vla-get-modelspace doc)
               (vla-get-paperspace doc))
             (vla-get-modelspace doc)
           )
 )
 (if (vl-catch-all-error-p (setq sort (vl-catch-all-apply 'vla-item (list (setq dic (vla-getextensiondictionary spc)) "ACAD_SORTENTS"))))
   (setq sort (vla-addobject dic "ACAD_SORTENTS" "AcDbSortentsTable"))
 )
 (vla-getfulldraworder sort 'order :vlax-false)
 (if (< 0 (vlax-safearray-get-u-bound order 1))
   (vlax-safearray->list order)
 )
)

(defun ssorder ( / ss )

 (vl-load-com)

 (setq ss (ssadd))
 (foreach e (reverse (mapcar (function vlax-vla-object->ename) (getOrder)))
   (if (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-curve-getstartpoint) (list e))))
     (ssadd e ss)
   )
 )
 ss
)

(defun c:myoverkill nil
 (OVERKILL-MR (ssorder) 100 1e-4)
 (princ)
)

M.R.

Thanks Marko,

Code works good now, tho its VEEEERY slow...

Got a drawing with 60.000+ lines, been running very long...

Any way to speed up the code?

My drawings are Only lines and arcs. :-)

Thanks!

By upper, do you mean the LINE with the highest elevation ? -David

Thanks Marko,

 

Code works good now, tho its VEEEERY slow...

Got a drawing with 60.000+ lines, been running very long...

Any way to speed up the code?

 

My drawings are Only lines and arcs. :-)

 

Thanks!

Change this :

(defun c:myoverkill nil
 (OVERKILL-MR (ssorder) 100 1e-4)
 (princ)
)

To this :

(defun c:myoverkill nil
 (OVERKILL-MR (ssorder) [b][color=red]10[/color][/b] 1e-4)
 (princ)
)

Hey David,

I mean the highest 'draworder', all lines have a evelation 0. (2-D drawings.)

I am still looking for a good solution.

The code given does the job quite wel, but it takes WAY to long...

When i have a drawing with 6000 lines, its running for almost an hour!

My drawings are just lines and arcs... any suggestions for some quiter code?

.NET will be fine too.. :0

Maybe compile Marko's code ... in a quick test here it speeds it up ~50%.

No no need to compile anything... The main trick is to pass correctly ordered selection set to built-in OVERKILL command... I tried it earlier when this topic was actual, but thought you solved the issue so I didn't mentioned this important notice...

(defun getOrder ( / doc spc dic sort order )

 (vl-load-com)

 (setq doc (vla-get-activeDocument (vlax-get-acad-object))
       spc (if (zerop (vla-get-activespace doc))
             (if (= (vla-get-mspace doc) :vlax-true)
               (vla-get-modelspace doc)
               (vla-get-paperspace doc))
             (vla-get-modelspace doc)
           )
 )
 (if (vl-catch-all-error-p (setq sort (vl-catch-all-apply 'vla-item (list (setq dic (vla-getextensiondictionary spc)) "ACAD_SORTENTS"))))
   (setq sort (vla-addobject dic "ACAD_SORTENTS" "AcDbSortentsTable"))
 )
 (vla-getfulldraworder sort 'order :vlax-false)
 (if (< 0 (vlax-safearray-get-u-bound order 1))
   (vlax-safearray->list order)
 )
)

(defun ssorder ( / s ss )

 (vl-load-com)

 (setq s (ssget "_:L" '((0 . "*POLYLINE,SPLINE,HELIX,LINE,ARC,CIRCLE,ELLIPSE"))))
 (setq ss (ssadd))
 (foreach e (reverse (mapcar (function vlax-vla-object->ename) (getOrder)))
   (if (ssmemb e s)
     (ssadd e ss)
   )
 )
 ss
)

(defun c:myoverkill nil
 (vl-cmdf "_.-OVERKILL" (ssorder) "" "_O" 1e-6 "_I" "_A" "_P" "_Y" "")
 (princ)
)

Regards, M.R.

Hey Marko,

Thanks for your reply again!

Too bad the 'order' doesnt seem to work with the regular overkill.

The code is very fast now, but doesnt follow the draworder. :-(

Why would you have a drawing with so many overlapping or duplicate lines to begin with? I think you are looking at the problem the wrong way. Good CAD drafting practices is the place to start.

@ReMark,

Unfortunatly the cause of the problem is out of my reach.

In the Netherlands, the whole country is downloadable in DWG.

BUT... this DWG is made out of 'closed' polylines for each use of something.

So every building is a closed polyline, but also all gras, water, pavement and... everything.

So... on all locations where a building meets grass/water/pavement there is a double line.

One of the building, and one of the grass for example.

I made a LISP that, converts everything to lines/arcs and sorts all layers to the right draworder, but now need to clean the drawing up...

I added a DWG as example. This is a very small area. Most 'DWG's have about 10.000 entities.

EDIT: Also added a example of a 'small' project locatation.

For this DWG, the 'OVERKILL-MR' command gets stuck. :-(

But again, we GET this info, so my drawing skills have nothing to do with it.

Example.dwg

Example large.dwg

In an earlier post you wrote...."When i have a drawing with 6000 lines, its running for almost an hour!"

OK. I opened the example large drawing and ran the Overkill command on it which took about 1 second. There were 2110 duplicate and 31 overlapping lines. What's taking you so long?

Before running Overkill there were 5951 objects. After running Overkill there were 3810 objects.

When i run the REGULAR overkill command, its done instantly, but, it randomly deletes one of the duplicates.

Overkill does NOT look at the draworder. (Look at the magenta on green lines in the example dwg., with overkill, a lot of magenta lines are gone...

So i look for a solution like overkill, but doesnt mess up the display as the example drawings.

The given OVERKILL-MR command is a good solution for this, but that command runs for an hour...

The code below works reasonably well (tested on BricsCAD) and is fast enough. "Example large.dwg" is processed in under a minute. Note: the code only looks for entities that seem equal. It does not handle partial overlaps.

(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.
)

(defun c:Test ( / doc n ss)
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-endundomark doc)
 (vla-startundomark doc)
 (if (setq ss (ssget))
   (progn
     (setq n
       (BKG_OverkillEqual
         ss
         10   ; Number of segments. Not used when comparing pairs of lines.
         0.01 ; Fuzz.
       )
     )
     (princ (strcat "\n" (itoa n) " entities deleted "))
   )
 )
 (vla-endundomark doc)
 (princ)
)

BTW:

If the user makes a selection using a single window or crossing or if the "_All" option is used, the selection set is already in the draworder (first in set is top of draworder).

Thanks,

This is what i was looking for!

Works like a charm! :-)

I know this is an old topic. I am testing this within Autocad 2022 and with the Example Large.dwg. 

When I select all the objects and I get the following error. I do not think i have even seen this before.

Command: test
Select objects: Specify opposite corner: 5938 found
Select objects: Specify opposite corner: 5866 found (5865 duplicate), 5939 total
Select objects:
; error: bad argument type: variantp #<VLA-OBJECT IAcadArc 00000208bf523728>
Command:

Thanks for any ideas.