Shortening multiple polylines using LISP (or other method?)

Anonymous · ‎12-08-2017

I found a LISP routine to lengthen multiple polylines at once by a set number. However, what I need is to shorten them by a set amount, and this routine isn't working right with a negative delta. If the last line segment in the polyline is shorter than the trim amount, it reverses that line - in other words, it draws a new segment going backwards from the vertex, instead of trimming the next segment.

Attaching a file to illustrate the issue. The first polyline is the original. The second is the desired result (the result of using LENGTHEN). The third is what happens with this routine.

Does anyone have a fix? I need to trim hundreds of polylines by a fixed amount on each end and I don't want to do it manually. If there is a different command that might work, I'm all ears.

This is the code I am using:

(defun c:plen(/ plSet plDel plLst doMode dxfLst newEn newSt newPl)

(princ "\n <<< SELECT POLYLINES >>>")
(if
(and
(setq plSet(ssget '((0 . "LWPOLYLINE"))))
(setq plDel(getreal "\nSpecify delta: "))
); ena and
(progn
(setq plLst(vl-remove-if 'listp
(mapcar 'cadr(ssnamex plSet))))
(initget 1 "Positive Negative Both")
(if(setq doMode
(getkword "\nSpecify direction [Positive/Negative/Both]: "))
(progn
(foreach pl plLst
(setq dxfLst(entget pl)
verLst(mapcar 'cdr(vl-remove-if-not
'(lambda(x)(= 10(car x)))dxfLst))
newEn(polar(cadr(reverse verLst))
(angle(cadr(reverse verLst))(car(reverse verLst)))
(+(distance(cadr(reverse verLst))(car(reverse verLst)))plDel))
newSt(polar(cadr verLst)
(angle(cadr verLst)(car verLst))
(+(distance(cadr verLst)(car verLst))plDel))
); end setq
(cond
((= "Positive" doMode)
(setq newPl(reverse
(subst(cons 10 newEn)
(assoc 10(reverse dxfLst))(reverse dxfLst))))
); end conditon #1
((= "Negative" doMode)
(setq newPl(subst(cons 10 newSt)
(assoc 10 dxfLst)dxfLst))
); end condition #2
((= "Both" doMode)
(setq dxfLst(subst(cons 10 newSt)
(assoc 10 dxfLst)dxfLst)
newPl(reverse
(subst(cons 10 newEn)
(assoc 10(reverse dxfLst))(reverse dxfLst))))
); end condition #3
); end cond
(entmod newPl)
); end foreach
); end progn
); end if
); end progn
); end if
(princ)
); end of c:plen

Ranjit_Singh · ‎12-08-2017

Maybe like this. Specify total delta and half will be added (or subtracted if provided negative number) from each end

(defun c:somefunc  (/ adoc del ss1 tot)
 (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
 (setq ss1 (ssget '((0 . "line,lwpolyline"))))
 (and ss1
      (setq tot (getdist "\nSpecify total delta length: "))
      (mapcar '(lambda (x)
                (command-s "._isolateobjects" x "")
                (cond ((> (getpropertyvalue x "Length") tot)
                       (setq del (/ tot 2.0))
                       (command-s "._lengthen" x "_delta" del (vlax-curve-getstartpoint x) (vlax-curve-getendpoint x) "")
                       (command-s "._unisolateobjects"))))
              (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss1)))))
 (vla-endundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object)))))

Kent1Cooper · ‎12-08-2017

It looks [without studying in great detail] like it's just moving the end vertices. And I imagine it would have very peculiar results if the end segment is an arc segment rather than a line segment. It could be done in a way that would deal correctly with either the too-short-end-segment or the arc-end-segment situation, with the actual LENGTHEN command. In shortening only, it could also be done using BREAK with some calculation of where to Break from.

A related routine that uses LENGTHEN is LengthenTotalMid.lsp, >>here<<. That's asking for a total length, and it calculates the delta [positive or negative] from the relationship of that to the existing length. But it could be altered easily enough to do what you're asking, if that seems promising.

EDIT: I forgot there were further-developed versions later in that thread, the last one being >>this<<.

Kent Cooper, AIA

Kent1Cooper · ‎12-08-2017

Oh, and there's also this thread. It's a lot simpler, including not accounting for the possibility that something else might be at an endpoint. @Ranjit_Singh's routine deals with that by isolating the object. My links in Post 3 avoid the need to do that, by giving a list of entity name and endpoint [see comments in the first link]. All my linked ones will work on various object types, not just Polylines. Ranjit's could be made to allow more than just Lines and Polylines, by using a different method of checking the current length -- not all Lengthenable objects have their length in a "Length" VLA property, but this will get the length of any kind, if 'obj' is a VLA object:

(vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj))

Kent Cooper, AIA

Anonymous · ‎12-08-2017

This works great except ... it's changing some setting I can't figure out, I think. The lines trim, but then if I try to select them to copy them, they don't select. They LOOK selected, but I can't copy them or modify their properties.

I might be able to find a workaround, but if you have any idea what the setting issue might be, please let me know. Thanks!

@Ranjit_Singh wrote:
Maybe like this. Specify total delta and half will be added (or subtracted if provided negative number) from each end

Ranjit_Singh · ‎12-08-2017

@Anonymous wrote:

This works great except ... it's changing some setting I can't figure out...........

I am not changing any variables. Not sure what is happening. Can you post your command output. It will help to understand the problem.

Anonymous · ‎12-08-2017

@Ranjit_Singh wrote:
@Anonymous wrote:
This works great except ... it's changing some setting I can't figure out...........
I am not changing any variables. Not sure what is happening. Can you post your command output. It will help to understand the problem.

Note that I changed the name of the routine and added explanatory text because this may be used by other people in my office, but I didn't change anything else.

I'm also attaching the file with the edited polylines in it ... they behave strangely and I'm unable to move them to a different layer.

Command: APPLOAD
ShortenPolylines.lsp successfully loaded.
Command:
Shorten Polylines Loaded. Enter plshorten to run.
Command:
Command: PLSHORTEN
Select objects: Specify opposite corner: 2 found
Select objects:
Specify total delta length (negative to shorten, positive to lengthen): -20
._isolateobjects
Select objects: 1 found
Select objects: ._lengthen
Select an object to measure or [DElta/Percent/Total/DYnamic] <Total>:
Current length: 32.3991
Select an object to measure or [DElta/Percent/Total/DYnamic] <Total>: _delta
Enter delta length or [Angle] <0.0000>: -10.00000000000000
Select an object to change or [Undo]:
Select an object to change or [Undo]:
Select an object to change or [Undo]: ._unisolateobjects
1 object(s) unisolated.
._isolateobjects
Select objects: 1 found
Select objects: ._lengthen
Select an object to measure or [DElta/Percent/Total/DYnamic] <DElta>:
Current length: 32.3991
Select an object to measure or [DElta/Percent/Total/DYnamic] <DElta>: _delta
Enter delta length or [Angle] <-10.0000>: -10.00000000000000
Select an object to change or [Undo]:
Select an object to change or [Undo]:
Select an object to change or [Undo]: ._unisolateobjects
1 object(s) unisolated.
nil

Anonymous · ‎12-08-2017

@Kent1Cooper wrote:
It looks [without studying in great detail] like it's just moving the end vertices. And I imagine it would have very peculiar results if the end segment is an arc segment rather than a line segment. It could be done in a way that would deal correctly with either the too-short-end-segment or the arc-end-segment situation, with the actual LENGTHEN command. In shortening only, it could also be done using BREAK with some calculation of where to Break from.

A related routine that uses LENGTHEN is LengthenTotalMid.lsp, >>here<<. That's asking for a total length, and it calculates the delta [positive or negative] from the relationship of that to the existing length. But it could be altered easily enough to do what you're asking, if that seems promising.

EDIT: I forgot there were further-developed versions later in that thread, the last one being >>this<<.

Kent, thanks, that looks good and I will try to figure out if I can work with it. I know a little LISP, but not much, so it's time-consuming for me to alter code (but I can often figure it out eventually).

Ranjit_Singh · ‎12-08-2017

Getting rid of the isolateobjects and unisolateobjects fixes the problem.

I(defun c:somefunc  (/ adoc del ss1 tot)
 (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
 (setq ss1 (ssget '((0 . "line,lwpolyline"))))
 (and ss1
      (setq tot (getdist "\nSpecify total delta length: "))
      (mapcar '(lambda (x)
                (cond ((> (getpropertyvalue x "Length") tot)
                       (setq del (/ tot 2.0))
                       (command-s "._lengthen" x "_delta" del (vlax-curve-getstartpoint x) (vlax-curve-getendpoint x) ""))))
              (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss1)))))
 (vla-endundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object)))))

If you have instances where different entities share the same begin or end point then it will produce inconsistent results. I would recommend using the lisp mentioned in post 3 by @Kent1Cooper

Kent1Cooper · ‎12-08-2017

@Kent1Cooper wrote:

.... it could be altered easily enough to do what you're asking, if that seems promising.

Give the attached LengthenBothEnds.lsp, with its LBE command, a try.

Kent Cooper, AIA

Anonymous · ‎12-08-2017

That is perfect, thank you, Kent.

There are a few lines in my drawing that were shorter than the length I was trying to shorten by - I wonder if that was the issue before.

john.uhden · ‎12-08-2017

See if this does what you want.

(defun c:SHORTEN ( / *error* vars vals ss i obj amount elen end param tooshort plist @2d)
  ;; Written (12-08-17) for @aospovat by John Uhden.
  ;; NOTES:
    ;; This is not written to handle heavy or 3D polylines, only LWPOLYLINEs.
    ;; This not written to shorten a selected end of a polyine.
    ;; It will shorten only the end of the polyline.
    ;; It will not shorten closed polylines.
    ;; See note below about bulges.
  (vl-load-com)
  (defun *error* (err)
    (mapcar 'setvar vars vals)
    (vla-endundomark *doc*)
    (cond
      ((not err))
      ((wcmatch (strcase err) "*CANCEL*,*QUIT*"))
      (1  (princ (strcat "\nERROR: " err)))
    )
    (princ)
  )
  (or *acad* (setq *acad* (vlax-get-acad-object))) ;; global
  (or *doc* (setq *doc* (vla-get-ActiveDocument *acad*))) ;; global
  (vla-endundomark *doc*)
  (vla-startundomark *doc*)
  (setq vars '("cmdecho"))
  (setq vals (mapcar 'getvar vars))
  (mapcar 'setvar vars '(0))
  (command "_.expert" (getvar "expert")) ;; dummy command
  (defun @2d (p)(list (car p)(cadr p)))
  (and
    (setq tooshort 0 )
    (not (initget 7))
    (setq amount (getdist "\nEnter amount to shorten: "))
    (setq ss (ssget '((0 . "LWPOLYLINE")(-4 . "<NOT")(-4 . "&")(70 . 1)(-4 . "NOT>")))) ;; not closed
    (repeat (setq i (sslength ss))
      (setq obj (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
      (setq elen (vlax-curve-getdistatparam obj (vlax-curve-getendparam obj)))
      (setq plist nil)
      (if (<= elen amount)
        (setq tooshort (1+ tooshort))
        (progn
          (setq end (vlax-curve-getparamatdist obj (- elen amount)))
          (setq p (vlax-curve-getpointatparam obj end))
         ;; (vl-cmdf "_.POINT" "non" p) ;; just for testing
          (setq param 0)
          (while (<= param end)
            (setq plist (cons (vlax-curve-getpointatparam obj param) plist))
            (setq param (1+ param))
          )
          (if (/= param end)
            (setq plist (cons p plist))
          )
          (vlax-put obj 'Coordinates (apply 'append (reverse (mapcar '@2d plist))))
          ;; NOTE: where the shortened end point is on a curved segment
          ;; the bulge has to be adjusted for the radius to stay the same.
          ;; That has not yet been included.
          1
        )
      )
    )
    (cond
      ((> tooshort 1)(princ (strcat "\n" (itoa tooshort) " polylines were too short to shorten.")))
      ((= tooshort 1)(princ "\n1 polyline was too short to shorten."))
    )
  )
  (*error* nil)
)

John F. Uhden

Community

Shortening multiple polylines using LISP (or other method?)

Shortening multiple polylines using LISP (or other method?)

Shortening multiple polylines using LISP (or other method?)