modify lisp to allow select multiple polylines

[jtm2020hyo]

i want change this autolisp to allow me select multiple polyline 

this lisp convert straight segments to arc segments . but one polyline for time .

(defun c:lwsegs2arced ( / massoclst nthmassocsubst v^v unit _ilp doc lw enx gr enxb p1 p2 p3 b i n )

  (vl-load-com)

  (defun massoclst ( key lst )
    (if (assoc key lst) (cons (assoc key lst) (massoclst key (cdr (member (assoc key lst) lst)))))
  )

  (defun nthmassocsubst ( n key value lst / k slst p j plst m tst pslst )
    (setq k (length (setq slst (member (assoc key lst) lst))))
    (setq p (- (length lst) k))
    (setq j -1)
    (repeat p
      (setq plst (cons (nth (setq j (1+ j)) lst) plst))
    )
    (setq plst (reverse plst))
    (setq j -1)
    (setq m -1)
    (repeat k
      (setq j (1+ j))
      (if (equal (assoc key (member (nth j slst) slst)) (nth j slst) 1e-6)
        (setq m (1+ m))
      )
      (if (and (not tst) (= n m))
        (setq pslst (cons (cons key value) pslst) tst t)
        (setq pslst (cons (nth j slst) pslst))
      )
    )
    (setq pslst (reverse pslst))
    (append plst pslst)
  )

  (defun v^v ( u v )
    (mapcar '(lambda ( s1 s2 a b ) (+ ((eval s1) (* (nth a u) (nth b v))) ((eval s2) (* (nth a v) (nth b u))))) '(+ - +) '(- + -) '(1 0 0) '(2 2 1))
  )

  (defun unit ( v )
    (mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v)
  )

  (defun _ilp ( p1 p2 o nor / p1p p2p op tp pp p )
    (if (not (equal (v^v nor (unit (mapcar '- p2 p1))) '(0.0 0.0 0.0) 1e-7))
      (progn
        (setq p1p (trans p1 0 (v^v nor (unit (mapcar '- p2 p1))))
              p2p (trans p2 0 (v^v nor (unit (mapcar '- p2 p1))))
              op  (trans o 0 (v^v nor (unit (mapcar '- p2 p1))))
              op  (list (car op) (cadr op) (caddr p1p))
              tp  (polar op (+ (* 0.5 pi) (angle '(0.0 0.0 0.0) (trans nor 0 (v^v nor (unit (mapcar '- p2 p1)))))) 1.0)
        )
        (if (inters p1p p2p op tp nil)
          (progn
            (setq p (trans (inters p1p p2p op tp nil) (v^v nor (unit (mapcar '- p2 p1))) 0))
            p
          )
          nil
        )
      )
      (progn
        (setq pp (list (car (trans p1 0 nor)) (cadr (trans p1 0 nor)) (caddr (trans o 0 nor))))
        (setq p (trans pp nor 0))
        p
      )
    )
  )

  (or doc (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))))
  (vla-startundomark doc)
  (if (and (setq lw (entsel "\nPick LWPOLYLINE..."))
          (= (cdr (assoc 0 (setq enx (entget (car lw))))) "LWPOLYLINE")
      )
    (progn
      (setq i (fix (vlax-curve-getParamAtPoint
                  (car lw)
                  (vlax-curve-getClosestPointToProjection (car lw) (trans (cadr lw) 1 0) '(0.0 0.0 1.0))
                  ) ;_  vlax-curve-getParamAtPoint
              ) ;_  fix
           p1 (vlax-curve-getPointAtParam (car lw) i)
           p3 (vlax-curve-getPointAtParam (car lw) (1+ i))
           lw (car lw)
      )
      (setq enxb (massoclst 42 enx))
      (while (= 5 (car (setq gr (grread t))))
        (setq p2 (_ilp (trans (cadr gr) 1 0) (mapcar '+ (trans (cadr gr) 1 0) '(0.0 0.0 1.0)) p1 (cdr (assoc 210 (entget lw)))))
        (setq b ((lambda (a) (/ (sin a) (cos a)))
                (/ (- (angle (trans p2 0 lw) (trans p3 0 lw)) (angle (trans p1 0 lw) (trans p2 0 lw))) 2.0)
               )
        )
        (setq n -1)
        (foreach dxf42 enxb
          (setq n (1+ n))
          (if (= n i)
            (setq enx (nthmassocsubst n 42 b enx))
            (setq enx (nthmassocsubst n 42 (+ (cdr dxf42) b) enx))
          )
        )
        (entupd (cdr (assoc -1 (entmod enx))))
      )
    )
    (prompt "\n Nothing selected or picked object not a LWPOLYLINE ")
  )
  (vla-endundomark doc)
  (princ)
)

[Kent1Cooper]

Try this [minimally tested]:

(defun c:lwsegs2arced ( / massoclst nthmassocsubst v^v unit _ilp doc lw enx gr enxb p1 p2 p3 b i n )

  (vl-load-com)

  (defun massoclst ( key lst )
    (if (assoc key lst) (cons (assoc key lst) (massoclst key (cdr (member (assoc key lst) lst)))))
  )

  (defun nthmassocsubst ( n key value lst / k slst p j plst m tst pslst )
    (setq k (length (setq slst (member (assoc key lst) lst))))
    (setq p (- (length lst) k))
    (setq j -1)
    (repeat p
      (setq plst (cons (nth (setq j (1+ j)) lst) plst))
    )
    (setq plst (reverse plst))
    (setq j -1)
    (setq m -1)
    (repeat k
      (setq j (1+ j))
      (if (equal (assoc key (member (nth j slst) slst)) (nth j slst) 1e-6)
        (setq m (1+ m))
      )
      (if (and (not tst) (= n m))
        (setq pslst (cons (cons key value) pslst) tst t)
        (setq pslst (cons (nth j slst) pslst))
      )
    )
    (setq pslst (reverse pslst))
    (append plst pslst)
  )

  (defun v^v ( u v )
    (mapcar '(lambda ( s1 s2 a b ) (+ ((eval s1) (* (nth a u) (nth b v))) ((eval s2) (* (nth a v) (nth b u))))) '(+ - +) '(- + -) '(1 0 0) '(2 2 1))
  )

  (defun unit ( v )
    (mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v)
  )

  (defun _ilp ( p1 p2 o nor / p1p p2p op tp pp p )
    (if (not (equal (v^v nor (unit (mapcar '- p2 p1))) '(0.0 0.0 0.0) 1e-7))
      (progn
        (setq p1p (trans p1 0 (v^v nor (unit (mapcar '- p2 p1))))
              p2p (trans p2 0 (v^v nor (unit (mapcar '- p2 p1))))
              op  (trans o 0 (v^v nor (unit (mapcar '- p2 p1))))
              op  (list (car op) (cadr op) (caddr p1p))
              tp  (polar op (+ (* 0.5 pi) (angle '(0.0 0.0 0.0) (trans nor 0 (v^v nor (unit (mapcar '- p2 p1)))))) 1.0)
        )
        (if (inters p1p p2p op tp nil)
          (progn
            (setq p (trans (inters p1p p2p op tp nil) (v^v nor (unit (mapcar '- p2 p1))) 0))
            p
          )
          nil
        )
      )
      (progn
        (setq pp (list (car (trans p1 0 nor)) (cadr (trans p1 0 nor)) (caddr (trans o 0 nor))))
        (setq p (trans pp nor 0))
        p
      )
    )
  )

  (or doc (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))))
  (vla-startundomark doc)
;;;;;  (if
  (while ;;; < CHANGED from if to while
    (and
      (setq lw (entsel "\nPick LWPOLYLINE or <exit>: "))
      (= (cdr (assoc 0 (setq enx (entget (car lw))))) "LWPOLYLINE")
    )
;;;;;    (progn
      (setq i (fix (vlax-curve-getParamAtPoint
                  (car lw)
                  (vlax-curve-getClosestPointToProjection (car lw) (trans (cadr lw) 1 0) '(0.0 0.0 1.0))
                  ) ;_  vlax-curve-getParamAtPoint
              ) ;_  fix
           p1 (vlax-curve-getPointAtParam (car lw) i)
           p3 (vlax-curve-getPointAtParam (car lw) (1+ i))
           lw (car lw)
      )
      (setq enxb (massoclst 42 enx))
      (while (= 5 (car (setq gr (grread t))))
        (setq p2 (_ilp (trans (cadr gr) 1 0) (mapcar '+ (trans (cadr gr) 1 0) '(0.0 0.0 1.0)) p1 (cdr (assoc 210 (entget lw)))))
        (setq b ((lambda (a) (/ (sin a) (cos a)))
                (/ (- (angle (trans p2 0 lw) (trans p3 0 lw)) (angle (trans p1 0 lw) (trans p2 0 lw))) 2.0)
               )
        )
        (setq n -1)
        (foreach dxf42 enxb
          (setq n (1+ n))
          (if (= n i)
            (setq enx (nthmassocsubst n 42 b enx))
            (setq enx (nthmassocsubst n 42 (+ (cdr dxf42) b) enx))
          )
        )
        (entupd (cdr (assoc -1 (entmod enx))))
      )
;;;;;    )
;;;;;    (prompt "\n Nothing selected or picked object not a LWPOLYLINE ")
;;;;;  ); if
  ); while ;;; < CHANGED from if to while
  (vla-endundomark doc)
  (princ)
)

You can keep picking them, one at a time [because of the need to pick for the curviness of each] but as many as you want within one running of the command.

It ends with Enter or  if you either pick the wrong kind of thing or miss in picking.  With some additional code, it could be made to ask again in those situations.

[john.uhden]

It's not that easy.

Yes, it's easy to create a selection set of polylines, but your code relies on the pick point which ssget does not return unless you pick the poylines individually or by fence, unless you want to add bulges to all segments of all the selected polylines.  If that is the case then how do you want to determine the size and direction of the bulge, a fixed radius on the outside maybe?  A specific altitude?  A value related to the date or day of the year?  The age of Lincoln were he still alive?  The current number of Yankees home runs?  The cube root of the sum of the day's winning lottery numbers?

Then again, maybe you just wish to create bulged segments so that you can grip/stretch the midpoint.  If that may be the case then you might enjoy my BULGE.lsp (attached).  Existing segments can be straight.  The code is very ancient, but it still works.

[jtm2020hyo]

i want create bulges like the imagen but i need do this 1000 polylines for each time code is used , bulges size is a radio since base point . enter digits for determinate a radio might be useful .

[jtm2020hyo]

I need to select 1000 lines at a time , i need  all able selection options ,if possible .

[Kent1Cooper]

---

@jtm2020hyo wrote:

i want create bulges like the imagen but i need do this 1000 polylines for each time code is used , bulges size is a radio since base point . enter digits for determinate a radio might be useful .

---

Here's the huge difficulty with that.  How is a routine going to decide in which direction to bulge the segments?  If it should always go in the same direction relative to the direction the Polylines are drawn, you're just as likely to get results like this:

in which some bulge to one side and some to the other.  Is there anything about your 1000 Polylines from which a routine could decide which way to go?

Also, if you ask for a radius for the arc segments, what should happen if a Polyline line segment is too long  for that radius to be possible?  For example, a 2-unit-long line segment cannot be converted into an arc segments with a radius less than 1 unit, since there can be no arc of that radius that can reach between that segment's endpoints.

[jtm2020hyo]

i need that all selected polylines to work like an unique polyline and convert all their segments to arcs . direction and radio defined for (image) : (1) base point and (2) end point . and if possible add (d)igits for radio or a "(r)ight or (l)eft direction" options its better .

[Kent1Cooper]

Those arc segments are clearly not all of the same radius.  They probably all have the same bulge factor  as Polyline arc segments are defined -- that's what the original routine does.  That means that they all sweep through the same included angle.  Is that acceptable, instead of all having the same radius?

[john.uhden]

I think it might be good enough if he just pointed to the convex direction with two (2) getpoints.

Of course it still can't be assumed that all the polylines were drawn in the same general direction, so that would have to be determined within the code for each one.

As to the size of the bulge, I recommend using a constant altitude since the alternate method for computing the bulge is 2 * altitude divided by chord

[Kent1Cooper]

---

@john.uhden wrote:

.... 

As to the size of the bulge, I recommend using a constant altitude since the alternate method for computing the bulge is 2 * altitude divided by chord

---

I'm thinking constant bulge factor, because you can then simply stick in the (42 . 1.2345) or whatever it is [taken from the first one that the User would apply the original code to], in place of all (42 . 0.0) line-segment bulge factors in all Polylines' entity data lists -- no calculations to do, and it's the same for all of them, and there would be no possibility of an invalid value as there could be for a constant radius.  They claim the Polylines are all drawn in the same direction [in the image in Post 7], which if true would make it comparatively simple.

[jtm2020hyo]

yes, that is acceptable. i just want select 1000 polylines and use code to conver straight polylines segments to arcs . and if possible , vice versa .

[jtm2020hyo]

direction is not relevant . i just want convert polylines segments to arcs no matter directions like original code. and if possible add all select options , like select similars , all , etc . 

[jtm2020hyo]

direction no matter . if is left or right no matter . i just want select a lot of polylines .

but if everyone want just a direction for each use , i might suggest use "polyline reverse" option . but i'm not expert in autolisp .

[jtm2020hyo]

thanks for code , work like you explained us . do you might do a (F)ence selection option ? or a (P)revius selection option ? or anything from this page :

https://www.ellenfinkelstein.com/acadblog/use-all-of-your-selection-options/

[Kent1Cooper]

---

@Kent1Cooper wrote:

---

---

....  They claim the Polylines are all drawn in the same direction [in the image in Post 7]....

---

Now I'm not so sure.  Does "all polyline have same direction" mean that they will all be drawn  running in the same direction [as I assumed above], or that you want them all to bulge  in the same direction?  You also say in later Posts that direction is not relevant or does not matter.  Does that mean the direction of bulge can be either way, and possibly different from one Polyline to another?  A more extreme example of my image in Post 6:

Is that acceptable?  If they are not all drawn going in the same direction, and if you apply the same kind of bulge factor on all of them, that is the kind of result you can expect.

[Kent1Cooper]

---

@jtm2020hyo wrote:

thanks for code , work like you explained us . do you might do a (F)ence selection option ? or a (P)revius selection option ? ....

---

Not with that code.  It depends on / requires a selection of an individual Polyline, and it uses the point at which it was selected, and the movement of the cursor by the User after selection, to determine the shape of the arc segments.  A routine to do many at a time is going to need to go about it in a very different way.

[jtm2020hyo]

Then I need a new code to write.

Sadly I'm new in autolisp.

Anyone might help me?

[Kent1Cooper · Accepted solution]

---

@jtm2020hyo wrote:
Then I need a new code to write.
....

---

...

As a simple and basic starting point, this will impose a bulge factor of of 0.25 on all line segments in all selected LWPolylines:

(defun C:PLAA (/ ss n pldata) ; = Polyline Line segments All Arcs
  (if (setq ss (ssget ":L" '((0 . "LWPOLYLINE"))))
    (repeat (setq n (sslength ss))
      (setq pldata (entget (ssname ss (setq n (1- n)))))
      (entmod (subst '(42 . 0.25) '(42 . 0.0) pldata))
    )
  )
)

with this kind of result:

The four left-most Polylines were drawn from top down, and the far right one was drawn from bottom up, which is why it bulges to the other side.

You can select the Polylines by all the usual selection options.

The 0.25 bulge factor results in an included angle of approximately 56 degrees for each arc segment.  Increase the 0.25 for greater bulge -- 1.0 will give you full half-circle arc segments.

It will not  change any existing  arc segments to have that same bulge factor, but will only change line  segments in the originals, because it replace only bulge factors of 0 [which means line segments] with bulge factors of 0.25.

Things that would require adding more to the code:

::  if you want to have them all bulge in the same general direction, regardless of in what direction they were drawn [a better idea of the kinds of configurations you might have would be needed -- would it always be possible to determine a "same general direction"?];

::  if you want to have the User do the original-code thing on one Polyline, and then apply that same bulge factor to a selection set of others;

::  if you want the User to specify the bulge factor, or the swept angle of each arc segment, or a radius [which could result in impossible situations as described earlier], or some other criterion.

[john.uhden]

The constant bulge IS probably a better idea. I would provide a getreal
with a default value so that if a positive bulge were the wrong direction
they could run the routine again with a negative value.

I also think I would provide the standard Uhden method of selection
options...
/Layer(s)/Picklayer/Manually:

[jtm2020hyo]

this code in pretty good for my needs . but i'm not sure if should mark this as solved because the first request was to modify the original code to a more complete one . 

if no one asnwer in a time i will mark this as the solution .