Topic: Overkill in Block

[miquan]

Dear all,

I try to overkill duplicated lines in all blocks in drawing.

I used this Lee's lisp, but now it's not working for this block, please help me to fix.

Autolisp code:

Code: [Select]

;;http://www.cadtutor.net/forum/showthread.php?48469-Overkill-all-including-blocks&s=d39932f12a90fe5c87c3c8528193bf09
;; Line Kill  -  Lee Mac
;; Removes duplicate or zero-length lines from the drawing and
;; also from within blocks and nested blocks.

(defun c:LKILL ( / dup lck lst p1 p2 tol zln )
   
    (setq tol 1e-8  ;; Tolerance
          zln 0
          dup 0
    )
    (vlax-for lay (vla-get-layers (LM:acdoc))
        (if (= :vlax-true (vla-get-lock lay))
            (progn
                (setq lck (cons lay lck))
                (vla-put-lock lay :vlax-false)
            )
        )
    )
    (vlax-for blk (vla-get-blocks (LM:acdoc))
        (if (= :vlax-false (vla-get-isxref blk))
            (vlax-for obj blk
                (cond
                    (   (/= "AcDbLine" (vla-get-objectname obj)))
                    (   (equal 0.0
                            (distance
                                (setq p1 (vlax-get obj 'startpoint))
                                (setq p2 (vlax-get obj 'endpoint))
                            )
                            tol
                        )
                        (setq zln (1+ zln))
                        (vla-delete obj)
                    )
                    (   (vl-some
                            (function
                                (lambda ( x )
                                    (and (equal (car x) p1 tol) (equal (cadr x) p2 tol))
                                )
                            )
                            lst
                        )
                        (setq dup (1+ dup))
                        (vla-delete obj)
                    )
                    (   (setq lst (cons (list p1 p2) lst)))
                )
            )
        )
        (setq lst nil)
    )
    (foreach layer lck
        (vla-put-lock layer :vlax-true)
    )
    (vla-regen (LM:acdoc) acallviewports)
    (if (< 0 zln)
        (princ (strcat "\n" (itoa zln) " zero-length line" (if (= 1 zln) " removed." "s removed.")))
        (princ (strcat "\nNo zero-length lines found."))
    )
    (if (< 0 dup)
        (princ (strcat "\n" (itoa dup) " duplicate line" (if (= 1 dup) " removed." "s removed.")))
        (princ (strcat "\nNo duplicate lines found."))
    )
    (princ)
)

;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)
(vl-load-com)
(princ)

My block (see attached file)

Thanks,
Miquan

[hanhphuc]

ni hao.. the lines not duplicate, but just 2 short lines overlapped on a longer line.
Alternatively, U can use Express Tools command: OVERKILL, there is an option to remove overlap objects. thx

[miquan]

Dear,

Overkill is not working for block.

Thanks,
Miquan

[ChrisCarlson]

There's a grand total of 3 lines...why not just delete the one line which overlaps?

[miquan]

Hi
If there are some blocks,you can do it manually.
But I have about 500 blocks with different name.
Miquan

[snownut2]

As Lee points out, his program deletes duplicate lines, end points must be exactly the same.  The drawing you supplied has three lines all with different endpoints, although one line is on top of another it is not a duplicate. 

[Lee Mac]

This is only quickly put together but should perform as required:

Code - Auto/Visual Lisp: [Select]

1. (defun c:linekill ( / cnt doc lst )
2.     (setq doc (vla-get-activedocument (vlax-get-acad-object))
3.           cnt 0
4.     )
5.  
6.     ;; Retrieve all lines & line endpoints
7.     (vlax-for blk (vla-get-blocks doc)
8.         (if (= :vlax-false (vla-get-isxref blk))
9.             (vlax-for obj blk
10.                 (if (= "AcDbLine" (vla-get-objectname obj))
11.                     (setq lst (cons (list obj (vlax-get obj 'startpoint) (vlax-get obj 'endpoint)) lst))
12.                 )
13.             )
14.         )
15.     )
16.    
17.     ;; Bigger lines cannot be inside smaller lines
18.     (setq lst
19.         (vl-sort lst
20.            '(lambda ( a b )
21.                 (<  (distance (cadr a) (caddr a))
22.                     (distance (cadr b) (caddr b))
23.                 )
24.             )
25.         )
26.     )
27.  
28.     ;; Delete overlapping lines
29.     (foreach x lst
30.         (if
31.             (and
32.                 (vl-some
33.                    '(lambda ( y ) (apply 'inline (append (cdr x) (cdr y))))
34.                     (setq lst (cdr lst))
35.                 )
36.                 (vlax-write-enabled-p (car x))
37.                 (setq cnt (1+ cnt))
38.             )
39.             (vla-delete (car x))
40.         )
41.     )
42.  
43.     ;; Regenerate drawing
44.     (vla-regen doc acallviewports)
45.     (if (< 0 cnt)
46.         (princ (strcat "\n" (itoa cnt) " overlapping line" (if (= 1 cnt) "" "s") " deleted."))
47.         (princ "\nNo overlapping lines found.")
48.     )
49.     (princ)
50. )
51.  
52. (defun inline ( a b c d )
53.     (equal
54.         (+ (distance a c) (distance a b) (distance b d))
55.         (distance c d)
56.         1e-8
57.     )
58. )
59. (vl-load-com) (princ)

[miquan]

Dear Lee,

Thanks so much for your kindly help.

Miquan

[Lee Mac]

You're welcome Miquan