Polylines fix, remove pendulum etc...

[Fleww]

Hi, can you help me to make all this lines in just one polyline? I need to get only one line from this, or whatever just to dont have duplicates. I tried FLATTEN and OVERKILL but still have so much polylines one below the other.

Can you please help me with this, I need this blue line to have only one lenght when I use lisp with total lenght option.

[Fleww]

you can but it in one layer i dont mind

[hak_vz]

Place all your entities to same layer and run overkill, and it will remove all overlapping entities.

[Fleww]

No, its not enough. You can try it in file and I still have overlapping polylines/lines.

[hak_vz]

It is hard since in your drawing you have polylines with different vertexes drawn at same route. You have to decide what you can eliminate and than remove overlapped entities. If needed you can explode it. I have solved similar request at this forum, but can't find the code. I'll look for it later today, currently at work.

[Fleww]

Ok thank you so much I need this really, I know this is hard, any of this lines will be good, others can be deleted I mean it would be perfect.

[Fleww]

waiting for your answer thank you so much 🙂

[hak_vz]

How about this?  Exploded polylines with ignoring layer and color in overkill command

[hak_vz]

I can not find my code, in attachment is something old I have found years ago. It looks for all overlapping lines. IMO better option is to use OVERKILL as described above. At the end you will have to join lines to polylines. Work in single layer and you should receive good result.

[Fleww]

yea thank you for all of this but just not enough. 😕

[hak_vz]

After you remove all duplicate lines (using polylines would be too complicated), isolate each layer and use command pedit to join all remains into polylines. Joining them automatically could lead to error. Remember autocad is primarily drafting program and making some thing by hand shouldn't be a problem.

[Fleww]

tryed ofc before this post but it not enough in this case. its like 90% problem solved.

[CADaSchtroumpf]

In your drawing "OVERKILL" cannot work, the reasons:
- polylines with duplicate vertices (in places up to 4 vertices one on top of the other).
- extra/missing vertices with respect to another overlapping polyline.

In the code I suggest is that it will first remove all overlapping vertices for each polyline.
It will then if necessary create a vertex to match the additional vertex of the duplicate polyline.
This vertex will then be moved to the average of the 2 vertices of the duplicate polylines

The result will be that your polylines will be overlapped with unique and identical points.

From there two options are available to you!
Explode All your polylines, then use OVERKILL to remove all duplicates, optionally recompose polylines with PEDIT Multiple option.

Or (I see you have map object data) with AutocadMap, use the MAPCLEAN command

I understand that the result may not be perfect, but already much cleaner

(vl-load-com)
(defun remove_vtx (objent epoint / vertexlist cnt newlist index indexlist)
  (setq
    vertexlist (vlax-get objent "Coordinates")
    cnt 0
    newlist '()
    index (* 2 (fix (+ 0.5 (vlax-curve-getparamatpoint objent (vlax-curve-getclosestpointto objent epoint)))))
    indexlist (list index (1+ index))
  )
  (foreach ordinate vertexlist
    (if (not (vl-position cnt indexlist))
      (setq newlist (cons ordinate newlist))
    )
    (setq cnt (1+ cnt))
  )
  (not
    (vl-catch-all-apply 'vlax-put
      (list objent "Coordinates" (reverse newlist))
    )
  )
)
(defun add_vtx (obj at_prm ent_name / nw)
  (vla-addVertex
    obj
    (1+ (fix at_prm))
    (vlax-make-variant
      (vlax-safearray-fill
        (vlax-make-safearray vlax-vbdouble (cons 0 1))
          (list
            (car (trans (vlax-curve-getpointatparam obj at_prm) 0 ent_name))
            (cadr (trans (vlax-curve-getpointatparam obj at_prm) 0 ent_name))
          )
      )
    )
  )
  (vla-update obj)
  (list
    (car (trans (vlax-curve-getpointatparam obj at_prm) 0 ent_name))
    (cadr (trans (vlax-curve-getpointatparam obj at_prm) 0 ent_name))
    (caddr (trans (vlax-curve-getpointatparam obj at_prm) 0 ent_name))
  )
)
(defun c:vaccin_lwpoly ( / js n ent obj lst_pt indx js_pl i e l pt_tmp nw_prm pt_move)
  (setq js (ssget '((0 . "LWPOLYLINE"))))
  (cond
    (js
      (repeat (setq n (sslength js))
        (setq
          ent (ssname js (setq n (1- n)))
          obj (vlax-ename->vla-object ent)
          lst_pt (mapcar '(lambda (x) (trans x ent 0)) (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) (entget ent))))
          indx 0
        )
        (foreach pt lst_pt
          (setq indx (1+ indx))
          (if (equal pt (nth indx lst_pt) 1E-06)
            (remove_vtx obj (nth indx lst_pt))
          )
        )
      )
      (repeat (setq n (sslength js))
        (setq
          ent (ssname js (setq n (1- n)))
          obj (vlax-ename->vla-object ent)
          lst_pt (mapcar '(lambda (x) (trans x ent 0)) (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) (entget ent))))
        )
        (foreach pt lst_pt
          (setq js_pl (ssget "_C" (mapcar '- pt '(0.05 0.05 0.0)) (mapcar '+ pt '(0.05 0.05 0.0)) '((0 . "LWPOLYLINE"))))
          (ssdel ent js_pl)
          (cond
            (js_pl
              (repeat (setq i (sslength js_pl))
                (setq
                  e (ssname js_pl (setq i (1- i)))
                  l (mapcar '(lambda (x) (trans x ent 0)) (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) (entget e))))
                )
                (foreach el l
                  (if (not (member el lst_pt))
                    (cond
                      (
                        (and
                          (< (distance (setq pt_tmp (vlax-curve-getclosestpointto ent (trans el ent 0))) el) 1E-06)
                          (not (equal (setq nw_prm (vlax-curve-getparamatpoint ent pt_tmp)) (fix nw_prm) 1E-06))
                        )
                        (add_vtx obj nw_prm ent)
                        (setq
                          nw_pt (vlax-curve-getpointatparam ent (1+ (fix nw_prm)))
                          lst_pt (mapcar '(lambda (x) (trans x ent 0)) (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) (entget ent))))
                          pt_move (mapcar '* (mapcar '+ nw_pt el) '(0.5 0.5 0.5))
                        )
                        (entmod
                          (subst 
                            (cons 10 (list (car pt_move) (cadr pt_move)))
                            (list 10 (car (nth (vl-position el l) l)) (cadr (nth (vl-position el l) l)))
                            (entget e)
                          )
                        )
                        (set 'l (mapcar '(lambda (x) (trans x e 0)) (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) (entget e)))))
                        (entmod
                          (subst 
                            (cons 10 (list (car pt_move) (cadr pt_move)))
                            (list 10 (car (nth (1+ (fix nw_prm)) lst_pt)) (cadr (nth (1+ (fix nw_prm)) lst_pt)))
                            (entget ent)
                          )
                        )
                        (set 'lst_pt (mapcar '(lambda (x) (trans x ent 0)) (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) (entget ent)))))
                      )
                    )
                  )
                )
              )
            )
          )
        )
      )
    )
  )
  (prin1)
)