delete longest segment in polyline

[marlance]

is it possible to delete the longest segment in a polyline?

regards,
roldan

[Lee_Mac]

Try the following program:

;; Delete Longest Polyline Segment  -  Lee Mac

(defun c:deletelongestseg ( / a d e h i j p s x y )
    (if (setq s (ssget "_:L" '((0 . "LWPOLYLINE"))))
        (repeat (setq i (sslength s))
            (setq e (ssname s (setq i (1- i)))
                  d 0.0
                  y nil
            )
            (repeat (setq j (fix (vlax-curve-getendparam e)))
                (if (< d (setq a (- (vlax-curve-getdistatparam e j) (vlax-curve-getdistatparam e (setq j (1- j))))))
                    (setq d a p j)
                )
            )
            (setq x (entget e)
                  h (reverse (cons (assoc 210 x)  (member (assoc 39 x) (reverse x))))
                  x (vl-remove (assoc 210 x) (cdr (member (assoc 39 x) x)))
                  x (vl-member-if '(lambda ( x ) (cond ((and (= 10 (car x)) (= -2 (setq p (1- p))))) ((setq y (cons x y)) nil))) x)
            )
            (if (= 1 (logand 1 (cdr (assoc 70 h))))
                (entmod (append (subst (cons 70 (boole 4 1 (cdr (assoc 70 h)))) (assoc 70 h) h) x (reverse y)))
                (progn
                    (entmake (append h x))
                    (entmake (append h (reverse y)))
                    (entdel e)
                )
            ) 
        )
    )
    (princ)
)
(vl-load-com) (princ)

Lee

[hmsilva]

Nicely done.

Henrique

[marlance]

thanks lee for this.
i can't wait to try this in the office.

one more question.
how can i filter an open polyline which its first and second vertex are on the same location?
can you add that on the code you provided?

regards
roldan

[Lee_Mac]

hmsilva wrote:

Nicely done.

Henrique

Thank you Henrique!

[Lee_Mac]

rulep21 wrote:

thanks lee for this.
i can't wait to try this in the office.

You're welcome roldan.

rulep21 wrote:

one more question.
how can i filter an open polyline which its first and second vertex are on the same location?
can you add that on the code you provided?

This is not possible to implement using only an ssget selection filter - you would need to test each polyline in the selection, and process only those which meet the given criteria, e.g.:

;; Delete Longest Polyline Segment  -  Lee Mac

(defun c:deletelongestseg ( / a d e h i j p s x y )
    (if (setq s (ssget "_:L" '((0 . "LWPOLYLINE") (-4 . "<NOT") (-4 . "&=") (70 . 1) (-4 . "NOT>"))))
        (repeat (setq i (sslength s))
            (setq e (ssname s (setq i (1- i)))
                  x (entget e)
                  d 0.0
                  y nil
            )
            (if (equal (cdr (assoc 10 x)) (cdr (assoc 10 (cdr (member (assoc 10 x) x)))) 1e-8)
                (progn
                    (repeat (setq j (fix (vlax-curve-getendparam e)))
                        (if (< d (setq a (- (vlax-curve-getdistatparam e j) (vlax-curve-getdistatparam e (setq j (1- j))))))
                            (setq d a p j)
                        )
                    )
                    (setq h (reverse (cons (assoc 210 x)  (member (assoc 39 x) (reverse x))))
                          x (vl-remove (assoc 210 x) (cdr (member (assoc 39 x) x)))
                          x (vl-member-if '(lambda ( x ) (cond ((and (= 10 (car x)) (= -2 (setq p (1- p))))) ((setq y (cons x y)) nil))) x)
                    )
                    (if (= 1 (logand 1 (cdr (assoc 70 h))))
                        (entmod (append (subst (cons 70 (boole 4 1 (cdr (assoc 70 h)))) (assoc 70 h) h) x (reverse y)))
                        (progn
                            (entmake (append h x))
                            (entmake (append h (reverse y)))
                            (entdel e)
                        )
                    )
                )
            )
        )
    )
    (princ)
)
(vl-load-com) (princ)

[marlance]

how about writing a writing a separate program to filter those polyline?
and i noticed that in all the codes you've written, you always localise your variable.
what is the advantage of localising variable in a lisp?

[Lee_Mac]

rulep21 wrote:

how about writing a writing a separate program to filter those polyline?

The above posted code will already filter the polylines as required.

rulep21 wrote:

and i noticed that in all the codes you've written, you always localise your variable.
what is the advantage of localising variable in a lisp?

Please refer to my tutorial on Localising Variables.

Lee

[Kent1Cooper]

Here's my take on it [already underway while other replies came in], in simplest terms, without the usual controls, etc., yet, and so far it wants a single Polyline selected, but that could be expanded easily enough.

It is not bothered by the first-two-vertices-coincide situation you describe, and it also works on "heavy" 2D and also 3D Polylines.

However, in limited testing, it seems that for a closed Polyline in which the longest segment is the last one, it keeps that segment and removes the rest.  There's probably some way around that, but if Lee's works better for you in other respects, I won't bother working on that.

(defun C:PDLS ; = Polyline Delete Longest Segment
  (/ pl par lengths)
  (setq pl (car (entsel "\nSelect Polyline to Delete its Longest Segment: ")))
  (repeat (setq par (fix (vlax-curve-getEndParam pl)))
    (setq lengths ; list of dotted pairs of parameters with lengths
      (cons
        (cons ; dotted pair of parameter with segment length
          par
          (- ; length of segment ending at parameter
            (vlax-curve-getDistAtParam pl par)
            (vlax-curve-getDistAtParam pl (setq par (1- par)))
          ); -
        ); cons
        lengths
      ); cons
    ); setq [lengths]
  ); repeat
  (setq par (caar (vl-sort lengths '(lambda (a b) (> (cdr a) (cdr b))))))
    ; = parameter value at end of longest segment
  (command "_.break" pl ; [given entity, asks for first point without F option]
    "_none" (vlax-curve-getPointAtParam pl (1- par)); start of longest segment
    "_none" (vlax-curve-getPointAtParam pl par); end of longest segment
  ); command
); defun

[marlance]

i'll try your version kent when i get back in our office.
i'm so excited to try those codes you've written guys.

many thanks to all of of guys

regards,
roldan

[marlance]

Hi lee

see image below .

I want to filter those polylines hightlighted in red.

Is that possible?

[Lee_Mac]

Can you post a (small) sample drawing?

[Kent1Cooper]

---

@rulep21 wrote:

....

I want to filter those polylines hightlighted in red.

Is that possible?

---

I agree that a sample drawing would help define the problem.  Are the circled areas parts of continuous-through contours that loop back and partially re-trace over themselves before going on?  Or are they separate closed Polylines that partially coincide with parts of contours that go through?  If the former, I can't imagine a way to filter for them in (ssget) or Qselect or Filter -- you would probably need to select all Polylines, and step through looking for any that have the same locations for more than one vertex.  If the latter, (ssget) or Qselect could filter for closed Polylines and at least narrow it down, though it wouldn't be the end of the story, because closed contour lines certainly occur without such conditions, around hilltops and retention basins and the like.

[marlance]

Hi Lee/Kent,

Here's the sample drawing.

[Kent1Cooper]

---

@rulep21 wrote:

.... 

Here's the sample drawing.

---

Since the subject Polylines all seem to be visually closed but not Closed in AutoCAD's meaning of that word for Polylines, you can check for Polylines whose starting and ending vertices are at the same place.  This turns them green, but you could instead move them to a different Layer, or put them into a selection set to use some other command on, or whatever you prefer.  Minimally tested.

(setq ss (ssget "_X" '((0 . "LWPOLYLINE"))))
(repeat (setq n (sslength ss))
  (setq
    pl (ssname ss (setq n (1- n)))
    verts
      (vl-remove-if-not
        '(lambda (x) (= (car x) 10))
        (entget pl)
      ); -remove- & verts
  ); setq
  (if (equal (car verts) (last verts) 1e-4)
    (command "_.chprop" pl "" "_color" 3 "")
  ); if   
); repeat

[Kent1Cooper]

---

@Kent1Cooper wrote:

.... 

However, in limited testing, it seems that for a closed Polyline in which the longest segment is the last one, it keeps that segment and removes the rest.  There's probably some way around that....

---

Back on the Subject, here's one way to get around that issue.  It's comparatively longer [partly to account for that and to allow using it on multiple Polylines at once, but more so because I put in typical controls, etc.], but it does seem to work.

[marlance]

just saw your response kent.
thanks for this.