Visual LISP, AutoLISP and General Customization
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

lisp to convert polyline containing tessellated segments to true arcs?

16 REPLIES 16
SOLVED
Reply
Message 1 of 17
zasanil
4045 Views, 16 Replies

lisp to convert polyline containing tessellated segments to true arcs?

I have a bunch of files containing many closed polylines where at the corners and ends they are straight polyline line segments forming an arc instead of  true arcs. I have been looking and googling but have yet to find a lisp that can take the entire polyline and convert those corners to true arcs. I've attached a small sample of some of the polylines I'm dealing with. If anyone had a lisp or know of one that works and could point me in the right direction that would be great.

Thanks.

Dan Nicholson C.I.D.
PCB Design Engineer
Tags (3)
16 REPLIES 16
Message 2 of 17
Kent1Cooper
in reply to: zasanil

This isn't the answer in your case [though parts of it may be usable in making a routine that does what you want], but for the case of Polylines that form complete regular polygons of any number of sides, I did a routine that will turn them into Circles, available here.  Your situation is different, not only in not involving complete polygons, but in that the short line segments making up your pseudo-curves are not all of the same length -- many of the end ones are shorter, and also some of the intermediate ones.

 

But I can sort of imagine a way to go about it:

1.  Establish a length that all the line segments in the pseudo-curves would be shorter than, presumably by asking the User;

2.  Take a selected Polyline and make a list of the lengths of all its segments in order;

3.  Evaluate the list for sequences of multiple adjacent segment lengths that are all shorter than the reference length;

4.  Possibly calculate a theoretical center of the equivalent arc segment [I expect that would be the trickiest part -- it can't be done the way PolygonToCircle.lsp does it], and check that all the vertices along that sequence are the same distance from it, within some reasonable tolerance, to make sure they represent a kinked arc;

5.  Draw an Arc defined by the end vertices of that stretch and some vertex in the middle of it;

6.  Break out the short segments from the Polyline;

7.  Join the Arc with the two Polylines.

 

You can do it manually from step 5 to the end, but getting the preceding steps into a routine seems like a challenge....

 

Would there ever be re-entrant double curves [S-shapes], with a change in the direction of curvature within a series of short line segments?  The above approach wouldn't work in that case -- it would be necessary to add to step 4 and evaluate such a sequence for all of its changes in direction to be bending in the same direction, and only make an arc segment from those that do, leaving the ones that turn in the other direction for another arc segment.

 

Maybe it could do step 5 before step 4, and use the center of the resulting Arc to check distances from, so it doesn't need to calculate a center.

Kent Cooper, AIA
Message 3 of 17
zasanil
in reply to: Kent1Cooper

I'm pretty sure there would be cases where there would be "s" curves.

I think even if it was a partial arc where only segments next to each other having the same angle and all the same length were all converted to a arc would be helpful to reduce the calculation time for some of my processes on these drawings.

Dan Nicholson C.I.D.
PCB Design Engineer
Message 4 of 17
mpalan2009
in reply to: zasanil

I had a function that would take a selection set of line and convert them to ADT walls. There was an option or variable to only use lines within a tolerance of 5 degrees rotation of each other. In a list of line segments there might be a way to:

 

pseudo code something...

 

count = 1
get the rotation of the first segment
count = 2
loop
get the rotation of the current segment
if (> (- ang1 ang2) tolerance)
add line to curve collection
else set count greater then loop & exit
loop

 

Find the center point of the arc by the intersection of a segment perpendicular to the first and last line in the curve collection.

 

This could also give you a radius to find the bulge factor.


This type of check could also lead to finding positive or negative difference that would tell you if a curve started to go the other way.

 

Hope this makes sense to someone.
Just my ramblings.
Matt

Message 5 of 17
stevor
in reply to: zasanil

Considered PEDIT Fit, and then EXPLODE?

Much easier than a running BiArc sequence.

S
Message 6 of 17
zasanil
in reply to: stevor

I tried the pedit fit command but it really messed up the polylines. I think it would require too much manual work to use that on the entire drawing.

Dan Nicholson C.I.D.
PCB Design Engineer
Message 7 of 17
stevor
in reply to: zasanil


Of course 'too much manual,'
that is the 'Auto part of autolisp.

Your example may be too rare
to find a ready made solution,
but like procedures have been done,
like for topo line simplifications.

One method, analogous  to Matt's,
would be to parse each pline,
 by segment length and turn angle,
into 'straights and curves.
Ie, make a copy of the pline,
and break it at the ends of the 'straights.'

Then, for the curves, use either a pedit fit,
 or  some ARC approximation by least squares,
or averages, etc.

 

S
Message 8 of 17
marko_ribar
in reply to: stevor

If you had a drawing that has correct drawn entities (lwpolylines), created with routines posted here :

http://www.theswamp.org/index.php?topic=41837.msg523246#msg523246

(you have to be member to download them)

 

1. draw closed polyline with pline command that has arcs

2. use pline-arcs-seg.lsp to convert it to corresponding segmented lwpolyline (delete original)

3. use clpls.lsp to get rid of duplicate vertices that may occur on segmented lwpolyline

4. use chiv.lsp to change position of initial vertex of segmented lwpolyline (should not be on arced segmentations)

 

If this kind of segmented closed lwpolyline are the entities that should be converted back to arced closed lwpolyline like the original one created after step 1., then this code should do it, but with your polylines that are bad, its impossible to make good corrections... I would start over again drawing them if I were you, or keep them as they are drawn - uncorrect...

 

(defun c:convseglw2arcedlw ( / 3parc lw vl dl dll dllg dllgr ss v1 v2 v3 avl pea )

  (vl-load-com)

  (defun 3parc ( p1 p2 p3 lay / mid clockwise-p ang1 ang2 cen eang mid1 mid2 rad sang )

    (defun mid ( p1 p2 )
      (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) p1 p2)
    )

    (defun clockwise-p ( p1 p2 p3 ) ; Gile
      (< (sin (- (angle p1 p3) (angle p1 p2))) -1e-14)
    )
    
    (setq ang1 (angle p1 p2) ang2 (angle p2 p3)
          mid1 (mid p1 p2)   mid2 (mid p2 p3)
    
          cen  (inters mid1 (polar mid1 (+ ang1 (/ pi 2.)) 1.)
                       mid2 (polar mid2 (+ ang2 (/ pi 2.)) 1.) nil)
          
          rad  (distance cen p1)
    )

    (if (clockwise-p p1 p2 p3)
      (setq sAng (angle cen p3)
            eAng (angle cen p1)
      )
      (setq sAng (angle cen p1)
            eAng (angle cen p3)
      )
    )

    (entmakex (list (cons 0 "ARC")
                    (cons 8 lay)
                    (cons 10 cen)
                    (cons 40 rad)
                    (cons 50 sAng)
                    (cons 51 eAng)
              )
    )
  )

  (setq lw (car (entsel "\nPick segmented lwpolyline to convert it to arced lwpolyline...")))
  (while (or (null lw) (not (eq (cdr (assoc 0 (entget lw))) "LWPOLYLINE")))
    (prompt "\nMissed or picked wrong entity type... Please pick LWPOLYLINE entity again...")
    (setq lw (car (entsel "\nPick segmented lwpolyline to convert it to arced lwpolyline...")))
  )
  (setq vl (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (eq (car x) 10)) (entget lw))))
  (if (eq 1 (logand (cdr (assoc 70 (entget lw))) 1))
    (setq vl (reverse (cons (car vl) (reverse vl))))
  )
  (setq dl (mapcar '(lambda ( a b ) (distance a b)) vl (cdr vl)))
  (setq dll dl)
  (while dll
    (setq dllg (cons (car dll) dllg))
    (setq dll (cdr dll))
    (while (equal (car dll) (cadr dll) 5e-4)
      (setq dllg (cons (car dll) dllg))
      (setq dll (cdr dll))
    )
    (setq dllg (cons (car dll) dllg))
    (setq dllg (cons (cadr dll) dllg))
    (setq dllgr (cons (reverse dllg) dllgr))
    (setq dllg nil)
    (if (= (length dll) 1) (setq dll (cdr dll)))
  )
  (setq dllgr (reverse dllgr))
  (setq ss (ssadd))
  (ssadd lw ss)
  (foreach g dllgr
    (if (> (length g) 3)
      (progn
        (setq v1 (trans (nth (1+ (vl-position (car g) dl)) vl) lw 0))
        (setq v2 (trans (nth (vl-position (nth (/ (length g) 2) g) dl) vl) lw 0))
        (setq v3 (trans (nth (vl-position (last g) dl) vl) lw 0))
        (command "_.BREAK" "_non" (trans v1 0 1) "_non" (trans v3 0 1))
        (ssadd (entlast) ss)
        (setq avl (cons (list v1 v2 v3) avl))
      )
    )
  )
  (foreach av avl
    (ssadd (3parc (car av) (cadr av) (caddr av) (cdr (assoc 8 (entget lw)))) ss)
  )
  (setq pea (getvar 'peditaccept))
  (setvar 'peditaccept 1)
  (command "_.PEDIT" "_M" ss "" "_J")
  (while (> (getvar 'cmdactive) 0) (command ""))
  (setvar 'peditaccept pea)
  (princ)
)

(defun c:cslw2alw nil (c:convseglw2arcedlw))
(prompt "\nInvoke with \"cslw2alw\"")
(princ)

 Regards, hope what I've explained that has some sense...

M.R.

Marko Ribar, d.i.a. (graduated engineer of architecture)
Message 9 of 17
zasanil
in reply to: marko_ribar

Hi Marko,

That lisp is getting close to what I needed. I tried it on my sample.dwg and was able to process about half of them.It had a few weird results on some of the polylines and a couple other polylines crashed the lisp. It was able to fix a lot of the polylines though! It would be cool if the user could select a group of polylines and have it process them all at once though.Redrawing all the polylines is not an option since they were generated from another peice of software, and there are way too many.

Nice effort Marko!

Dan Nicholson C.I.D.
PCB Design Engineer
Message 10 of 17
marko_ribar
in reply to: zasanil

Here, I've fixed my code to be acceptable and for open LWPOLYLINES... It should perform better than my previous code, only one thing you should check before you execute it on your lwpolylines - that's initial vertex... Please use posted clpls.lsp and CHIV.lsp on link I provided in my previous post... Initial vertex must not be on start/end or middle of arced segmentations - tessalations... If you are satisfied with the code, please mark it as solution, as I don't think much better can be accomplished... I assume your all polylines lie in WCS plane and you haven't changed UCS to be in 3D...

I would give myself a kudo if I could...

 

(defun c:convseglw2arcedlw ( / 3parc lw lay vl dl dll dllg dllgr ss v1 v2 v3 avl pea )

  (vl-load-com)

  (defun 3parc ( p1 p2 p3 lay / mid clockwise-p ang1 ang2 cen eang mid1 mid2 rad sang )

    (defun mid ( p1 p2 )
      (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) p1 p2)
    )

    (defun clockwise-p ( p1 p2 p3 ) ; Gile
      (< (sin (- (angle p1 p3) (angle p1 p2))) -1e-14)
    )
    
    (setq ang1 (angle p1 p2) ang2 (angle p2 p3)
          mid1 (mid p1 p2)   mid2 (mid p2 p3)
    
          cen  (inters mid1 (polar mid1 (+ ang1 (/ pi 2.)) 1.)
                       mid2 (polar mid2 (+ ang2 (/ pi 2.)) 1.) nil)
          
          rad  (distance cen p1)
    )

    (if (clockwise-p p1 p2 p3)
      (setq sAng (angle cen p3)
            eAng (angle cen p1)
      )
      (setq sAng (angle cen p1)
            eAng (angle cen p3)
      )
    )

    (entmakex (list (cons 0 "ARC")
                    (cons 8 lay)
                    (cons 10 cen)
                    (cons 40 rad)
                    (cons 50 sAng)
                    (cons 51 eAng)
              )
    )
  )

  (setq lw (car (entsel "\nPick segmented lwpolyline to convert it to arced lwpolyline...")))
  (while (or (null lw) (not (eq (cdr (assoc 0 (entget lw))) "LWPOLYLINE")))
    (prompt "\nMissed or picked wrong entity type... Please pick LWPOLYLINE entity again...")
    (setq lw (car (entsel "\nPick segmented lwpolyline to convert it to arced lwpolyline...")))
  )
  (setq lay (cdr (assoc 8 (entget lw))))
  (setq vl (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (eq (car x) 10)) (entget lw))))
  (setq vl (cons (car vl) (reverse (cons (car vl) (reverse vl)))))
  (setq dl (mapcar '(lambda ( a b ) (distance a b)) vl (cdr vl)))
  (setq dll dl)
  (while dll
    (setq dllg (cons (car dll) dllg))
    (setq dll (cdr dll))
    (while (equal (car dll) (cadr dll) 1e-6)
      (setq dllg (cons (car dll) dllg))
      (setq dll (cdr dll))
    )
    (setq dllg (cons (car dll) dllg))
    (setq dllg (cons (cadr dll) dllg))
    (setq dllgr (cons (reverse dllg) dllgr))
    (setq dllg nil)
    (if (= (length dll) 1) (setq dll (cdr dll)))
  )
  (setq dllgr (reverse dllgr))
  (setq ss (ssadd))
  (ssadd lw ss)
  (foreach g dllgr
    (if (> (length g) 3)
      (progn
        (setq v1 (trans (nth (1+ (vl-position (car g) dl)) vl) lw 0))
        (setq v2 (trans (nth (vl-position (nth (/ (length g) 2) g) dl) vl) lw 0))
        (setq v3 (trans (nth (vl-position (last g) dl) vl) lw 0))
        (command "_.BREAK" "_non" (trans v1 0 1) "_non" (trans v3 0 1))
        (if (entlast) (ssadd (entlast) ss))
        (setq avl (cons (list v1 v2 v3) avl))
      )
    )
  )
  (foreach av avl
    (ssadd (3parc (car av) (cadr av) (caddr av) lay) ss)
  )
  (setq pea (getvar 'peditaccept))
  (setvar 'peditaccept 1)
  (command "_.PEDIT" "_M" ss "" "_J")
  (while (> (getvar 'cmdactive) 0) (command ""))
  (setvar 'peditaccept pea)
  (princ)
)

(defun c:cslw2alw nil (c:convseglw2arcedlw))
(prompt "\nInvoke with \"cslw2alw\"")
(princ)

 HTH, M.R.

Marko Ribar, d.i.a. (graduated engineer of architecture)
Message 11 of 17
zasanil
in reply to: marko_ribar

Marko,

That performs much better! I think there was only one polyline that it didn't like but it converted many more of them. Thanks for all the programming!

Dan Nicholson C.I.D.
PCB Design Engineer
Message 12 of 17
marko_ribar
in reply to: zasanil

Dan, thanks for kudo... I've modified the code further more... Also important pre procedure is clpls.lsp and CHIV.lsp... After that it should work unless the entity is equal sided polygon... For this, you can quickly encolose it with circle...

 

(defun c:convseglw2arcedlw ( / 3parc lw lay vl dl dll dllg dllgr ss lg v1 v2 v3 avl pea )

  (defun 3parc ( p1 p2 p3 lay / mid clockwise-p ang1 ang2 cen eang mid1 mid2 rad sang )

    (defun mid ( p1 p2 )
      (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) p1 p2)
    )

    (defun clockwise-p ( p1 p2 p3 ) ; Gile
      (< (sin (- (angle p1 p3) (angle p1 p2))) -1e-14)
    )
    
    (setq ang1 (angle p1 p2) ang2 (angle p2 p3)
          mid1 (mid p1 p2)   mid2 (mid p2 p3)
    
          cen  (inters mid1 (polar mid1 (+ ang1 (/ pi 2.)) 1.)
                       mid2 (polar mid2 (+ ang2 (/ pi 2.)) 1.) nil)
          
          rad  (distance cen p1)
    )

    (if (clockwise-p p1 p2 p3)
      (setq sAng (angle cen p3)
            eAng (angle cen p1)
      )
      (setq sAng (angle cen p1)
            eAng (angle cen p3)
      )
    )

    (entmakex (list (cons 0 "ARC")
                    (cons 8 lay)
                    (cons 10 cen)
                    (cons 40 rad)
                    (cons 50 sAng)
                    (cons 51 eAng)
              )
    )
  )

  (setq lw (car (entsel "\nPick segmented lwpolyline to convert it to arced lwpolyline...")))
  (while (or (null lw) (not (eq (cdr (assoc 0 (entget lw))) "LWPOLYLINE")))
    (prompt "\nMissed or picked wrong entity type... Please pick LWPOLYLINE entity again...")
    (setq lw (car (entsel "\nPick segmented lwpolyline to convert it to arced lwpolyline...")))
  )
  (setq lay (cdr (assoc 8 (entget lw))))
  (setq vl (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (eq (car x) 10)) (entget lw))))
  (setq vl (cons (car vl) (reverse (cons (car vl) (cons (car vl) (reverse vl))))))
  (setq dl (mapcar '(lambda ( a b ) (distance a b)) vl (cdr vl)))
  (setq dll dl)
  (while dll
    (setq dllg (cons (car dll) dllg))
    (setq dll (cdr dll))
    (while (equal (car dll) (cadr dll) 1e-6)
      (setq dllg (cons (car dll) dllg))
      (setq dll (cdr dll))
    )
    (setq dllg (cons (car dll) dllg))
    (setq dllg (cons (cadr dll) dllg))
    (setq dllgr (cons (reverse dllg) dllgr))
    (setq dllg nil)
    (if (= (length dll) 1) (setq dll (cdr dll)))
  )
  (setq dllgr (reverse dllgr))
  (setq dllgr (mapcar '(lambda ( x ) (vl-remove nil x)) dllgr))
  (setq ss (ssadd))
  (ssadd lw ss)
  (foreach g dllgr
    (if (> (length g) 3)
      (progn
        (if (and lg (equal lg (cadr g))) (setq v1 v3) (setq v1 (trans (nth (1+ (vl-position (car g) dl)) vl) lw 0)))
        (setq v2 (if (equal (trans (nth (1+ (vl-position (list (car v1) (cadr v1)) vl)) vl) lw 0) v1) (trans (nth (1+ (1+ (vl-position (list (car v1) (cadr v1)) vl))) vl) lw 0) (trans (nth (1+ (vl-position (list (car v1) (cadr v1)) vl)) vl) lw 0)))
        (setq v3 (trans (nth (vl-position (setq lg (last g)) dl) vl) lw 0))
        (command "_.BREAK" "_non" (trans v1 0 1) "_non" (trans v3 0 1))
        (if (entlast) (ssadd (entlast) ss))
        (setq avl (cons (list v1 v2 v3) avl))
      )
    )
  )
  (while (> (getvar 'cmdactive) 0) (command ""))
  (foreach av avl
    (ssadd (3parc (car av) (cadr av) (caddr av) lay) ss)
  )
  (setq pea (getvar 'peditaccept))
  (setvar 'peditaccept 1)
  (command "_.PEDIT" "_M" ss "" "_J")
  (while (> (getvar 'cmdactive) 0) (command ""))
  (setvar 'peditaccept pea)
  (princ)
)

(defun c:cslw2alw nil (c:convseglw2arcedlw))
(prompt "\nInvoke with \"cslw2alw\"")
(princ)

 BTW. No need for (vl-load-com), also in previously posted codes...

 

Regards, Marko R.

Marko Ribar, d.i.a. (graduated engineer of architecture)
Message 13 of 17
zasanil
in reply to: marko_ribar

Hi Marko,

That lisp works pretty well also. I had a thought about having to use that chiv.lsp routine. What if you automatically made the origin of the polyline move to the midpoint of the longest segment in the closesd polyline? In my case here that would almost guarentee that the polyline would be ok.

Also, is it easy to make the program pick a set of polylines and run through each one? I'm looking at thousands of lines and one-by-one is unfeasable.

Great work!

Dan Nicholson C.I.D.
PCB Design Engineer
Message 14 of 17
marko_ribar
in reply to: zasanil

Everything you said is feasable, but unfortunately I am busy now... Something came to me that has higher priority... As for iterating through polylines, that's the simplest... You can find plethora such examples on www... Search for (ssget) and similar... As for chiv.lsp to be implemented it's possible, but I don't have time right now, you'll just have to adapt it - me thinks for longest segment try to sort dl variable by lenght - its stands for "distances lengths", and then obtain vertex with (nth (vl-position dd dl) vl) where dd is longest dl - (setq dd (car (vl-sort dl '>)))... And after you get vertex, you should pass it to implemented chiv.lsp and let modifications to happen... Beware that before you start new routine that has chiv.lsp implemented, you should apply clpls.lsp (make sure to get rid of duplicates vertices that may exist on polylines)... And that's it, many thanks for another kudo - use last posted code it's the best as it makes correct aquiering of start/next/end vertex of arced segments... Previous codes did work only because of possible correct assumptions for position of distance in dl for the next vertex, but if distances are the same - like n sided polygon then next vertex would be the same as start one and arc would be wrong... So this soultion last posted deserves kudo and I really appreciate you find it as better...

 

So long from me, have a nice coding... If you get stuck somewhere, just post and I am sure someone, or me will be willing to help...

 

Marko Ribar, d.i.a.

Marko Ribar, d.i.a. (graduated engineer of architecture)
Message 15 of 17
greg_battin
in reply to: marko_ribar

Marko,

I also wanted to say thank you for putting this routine together. One use I can immediately see myself using it for is when I have to use a PDF to DWG converter and the curved objects tend to be processed into segemented curves.

After testing in the routine in the sample .dwg provided in the first post I noticed that one of the objects was deformed after using the routine. I was able to correct it by simply reversing the polyline and then re-running the LISP on it and everything turned out fine. I just thought that I'd share that tip and also say thanks

 

~Greg

Message 16 of 17
marko_ribar
in reply to: zasanil


@zasanil wrote:

Hi Marko,

That lisp works pretty well also. I had a thought about having to use that chiv.lsp routine. What if you automatically made the origin of the polyline move to the midpoint of the longest segment in the closesd polyline? In my case here that would almost guarentee that the polyline would be ok.

Also, is it easy to make the program pick a set of polylines and run through each one? I'm looking at thousands of lines and one-by-one is unfeasable.

Great work!


Still, I've found some spare time to help you, if you still haven't figured that out... This version is for multiple selection and it should work fine in all UCS/Views...

 

(defun c:convseglws2arcedlws (/      clean_poly    chiv   3parc
                              _vl-position  s      i      lw     lay
                              vl     dl     dll    dllg   dllgr  ss
                              lg     v1     v2     v3     avl    pea
                             )

  (defun clean_poly (ent / trunc e_lst p_lst)

    (defun trunc (expr lst)
      (if (and lst (not (equal (car lst) expr)))
        (cons (car lst) (trunc expr (cdr lst)))
      )
    )

    (setq e_lst (entget ent))
    (if (= "LWPOLYLINE" (cdr (assoc 0 e_lst)))
      (progn
        (setq p_lst
                    (vl-remove-if-not
                      '(lambda (x)
                         (or (= (car x) 10)
                             (= (car x) 40)
                             (= (car x) 41)
                             (= (car x) 42)
                         )
                       )
                      e_lst
                    )
              e_lst
                    (vl-remove-if
                      '(lambda (x)
                         (member x p_lst)
                       )
                      e_lst
                    )
        )
        (if (= 1 (logand (cdr (assoc 70 e_lst)) 1))
          (while (equal (car p_lst) (assoc 10 (reverse p_lst)))
            (setq
              p_lst (reverse (cdr (member (assoc 10 (reverse p_lst))
                                          (reverse p_lst)
                                  )
                             )
                    )
            )
          )
        )
        (while p_lst
          (setq e_lst (append e_lst (trunc (assoc 10 (cdr p_lst)) p_lst))
                p_lst (member (assoc 10 (cdr p_lst)) (cdr p_lst))
          )
        )
        (entmod e_lst)
      )
    )
    (princ)
  )

  (defun chiv
         (e p / osm ss f ed edd eddd eddd1 eddd2 eddd3 newed m n i)

    (vl-load-com)

    (setq ed (entget e))
    (setq edd nil)
    (foreach ec ed
      (if (not
            (or (eq (car ec) 10)
                (eq (car ec) 40)
                (eq (car ec) 41)
                (eq (car ec) 42)
                (eq (car ec) 91)
                (eq (car ec) 210)
            )
          )
        (setq edd (cons ec edd))
      )
    )
    (setq edd (reverse edd))
    (setq eddd nil)
    (setq eddd1 nil)
    (setq eddd2 nil)
    (setq eddd (member (assoc 10 ed) ed))
    (setq m (vlax-curve-getparamatpoint
              e
              (vlax-curve-getclosestpointto e p)
            )
    )
    (if (assoc 91 ed)
      (setq n (* m 5))
      (setq n (* m 4))
    )
    (setq i 0)
    (foreach ec eddd
      (progn
        (setq i (+ i 1))
        (if (<= i n)
          (setq eddd1 (cons ec eddd1))
        )
        (if (> i n)
          (setq eddd2 (cons ec eddd2))
        )
      )
    )
    (setq eddd1 (reverse eddd1))
    (setq eddd3 (list (assoc 210 eddd2)))
    (setq eddd2 (cdr eddd2))
    (setq eddd2 (reverse eddd2))
    (setq newed (append edd eddd2 eddd1 eddd3))
    (entmod newed)
    (entupd e)
    (princ)
  )

  (defun 3parc (p1     p2     p3     lay    nor    /      mid
                clockwise-p   ang1   ang2   cen    eang   mid1   mid2
                rad    sang
               )

    (setq p1 (trans p1 0 nor)
          p2 (trans p2 0 nor)
          p3 (trans p3 0 nor)
    )

    (defun mid (p1 p2)
      (mapcar '(lambda (a b) (/ (+ a b) 2.0)) p1 p2)
    )

    (defun clockwise-p (p1 p2 p3) ; Gile
      (< (sin (- (angle p1 p3) (angle p1 p2))) -1e-14)
    )

    (setq ang1 (angle p1 p2)
          ang2 (angle p2 p3)
          mid1 (mid p1 p2)
          mid2 (mid p2 p3)

          cen  (inters mid1
                       (polar mid1 (+ ang1 (/ pi 2.)) 1.)
                       mid2
                       (polar mid2 (+ ang2 (/ pi 2.)) 1.)
                       nil
               )

          rad  (distance cen p1)
    )

    (if (clockwise-p p1 p2 p3)
      (setq sAng (angle cen p3)
            eAng (angle cen p1)
      )
      (setq sAng (angle cen p1)
            eAng (angle cen p3)
      )
    )

    (entmakex (list (cons 0 "ARC")
                    (cons 8 lay)
                    (cons 10 cen)
                    (cons 40 rad)
                    (cons 50 sAng)
                    (cons 51 eAng)
                    (cons 210 nor)
              )
    )
  )

  ;; (_vl-position 3.29 '(1.1 2.2 3.3 4.4 5.5 6.6 7.7 8.8 9.9) 0.01 nil) => 2 (!k => nil) ;;
  (defun _vl-position (e l tol k)
    (if (null k)
      (setq k 0)
    )
    (if (not (equal e (car l) tol))
      (progn
        (setq k (1+ k))
        (if (cdr l)
          (_vl-position e (cdr l) tol k)
          (setq k nil)
        )
      )
      k
    )
  )

  (prompt
    "\nSelect segmented lwpolyline(s) to convert it/them to arced lwpolyline(s)..."
  )
  (setq s (ssget "_:L" '((0 . "LWPOLYLINE"))))
  (while (null s)
    (prompt
      "\nEmpty sel.set... Please select segemnted LWPOLYLINE(S) again..."
    )
    (setq s (ssget "_:L" '((0 . "LWPOLYLINE"))))
  )
  (command "_.UCS" "_W")
  (setq pea (getvar 'peditaccept))
  (setvar 'peditaccept 1)
  (repeat (setq i (sslength s))
    (setq lw (ssname s (setq i (1- i))))
    (clean_poly lw)
    (setq lay (cdr (assoc 8 (entget lw))))
    (setq nor (cdr (assoc 210 (entget lw))))
    (setq vl
           (mapcar
             'cdr
             (vl-remove-if-not '(lambda (x) (eq (car x) 10)) (entget lw))
           )
    )
    (setq
      vl (cons (car vl)
               (reverse (cons (car vl) (cons (car vl) (reverse vl))))
         )
    )
    (setq dl (mapcar '(lambda (a b) (distance a b)) vl (cdr vl)))
    (if (eq 1 (logand (cdr (assoc 70 (entget lw))) 1))
      (progn
        (chiv
          lw
          (trans
            (list
              (car
                (nth (_vl-position (car (vl-sort dl '>)) dl 1e-10 nil) vl)
              )
              (cadr
                (nth (_vl-position (car (vl-sort dl '>)) dl 1e-10 nil) vl)
              )
              (cdr (assoc 38 (entget lw)))
            )
            lw
            0
          )
        )
        (setq vl (mapcar 'cdr
                         (vl-remove-if-not
                           '(lambda (x) (eq (car x) 10))
                           (entget lw)
                         )
                 )
        )
        (setq vl
               (cons (car vl)
                     (reverse (cons (car vl) (cons (car vl) (reverse vl))))
               )
        )
        (setq dl (mapcar '(lambda (a b) (distance a b)) vl (cdr vl)))
      )
    )
    (setq dll dl)
    (while dll
      (setq dllg (cons (car dll) dllg))
      (setq dll (cdr dll))
      (while (equal (car dll) (cadr dll) 1e-6)
        (setq dllg (cons (car dll) dllg))
        (setq dll (cdr dll))
      )
      (setq dllg (cons (car dll) dllg))
      (setq dllg (cons (cadr dll) dllg))
      (setq dllgr (cons (reverse dllg) dllgr))
      (setq dllg nil)
      (if (= (length dll) 1)
        (setq dll (cdr dll))
      )
    )
    (setq dllgr (reverse dllgr))
    (setq dllgr (mapcar '(lambda (x) (vl-remove nil x)) dllgr))
    (setq ss (ssadd))
    (ssadd lw ss)
    (foreach g dllgr
      (if (> (length g) 3)
        (progn
          (if (and lg (equal lg (cadr g)))
            (setq v1 v3)
            (setq v1
                   (trans
                     (list
                       (car
                         (nth (1+ (_vl-position (car g) dl 1e-10 nil)) vl)
                       )
                       (cadr
                         (nth (1+ (_vl-position (car g) dl 1e-10 nil)) vl)
                       )
                       (cdr (assoc 38 (entget lw)))
                     )
                     lw
                     0
                   )
            )
          )
          (setq v2
                 (if
                   (equal
                     (trans
                       (list (car (nth (1+ (_vl-position
                                             (list (car (trans v1 0 lw))
                                                   (cadr (trans v1 0 lw))
                                             )
                                             vl
                                             1e-10
                                             nil
                                           )
                                       )
                                       vl
                                  )
                             )
                             (cadr (nth (1+ (_vl-position
                                              (list (car (trans v1 0 lw))
                                                    (cadr (trans v1 0 lw))
                                              )
                                              vl
                                              1e-10
                                              nil
                                            )
                                        )
                                        vl
                                   )
                             )
                             (cdr (assoc 38 (entget lw)))
                       )
                       lw
                       0
                     )
                     v1
                     1e-8
                   )
                    (trans
                      (list
                        (car (nth (1+ (1+ (_vl-position
                                            (list (car (trans v1 0 lw))
                                                  (cadr (trans v1 0 lw))
                                            )
                                            vl
                                            1e-10
                                            nil
                                          )
                                      )
                                  )
                                  vl
                             )
                        )
                        (cadr (nth (1+ (1+ (_vl-position
                                             (list (car (trans v1 0 lw))
                                                   (cadr (trans v1 0 lw))
                                             )
                                             vl
                                             1e-10
                                             nil
                                           )
                                       )
                                   )
                                   vl
                              )
                        )
                        (cdr (assoc 38 (entget lw)))
                      )
                      lw
                      0
                    )
                    (trans
                      (list (car (nth (1+ (_vl-position
                                            (list (car (trans v1 0 lw))
                                                  (cadr (trans v1 0 lw))
                                            )
                                            vl
                                            1e-10
                                            nil
                                          )
                                      )
                                      vl
                                 )
                            )
                            (cadr (nth (1+ (_vl-position
                                             (list (car (trans v1 0 lw))
                                                   (cadr (trans v1 0 lw))
                                             )
                                             vl
                                             1e-10
                                             nil
                                           )
                                       )
                                       vl
                                  )
                            )
                            (cdr (assoc 38 (entget lw)))
                      )
                      lw
                      0
                    )
                 )
          )
          (setq v3
                 (trans
                   (list
                     (car
                       (nth (_vl-position (setq lg (last g)) dl 1e-10 nil)
                            vl
                       )
                     )
                     (cadr
                       (nth (_vl-position (setq lg (last g)) dl 1e-10 nil)
                            vl
                       )
                     )
                     (cdr (assoc 38 (entget lw)))
                   )
                   lw
                   0
                 )
          )
          (command "_.UCS" "_3P" "_non" v1 "_non" v2 "_non" v3)
          (command "_.BREAK"
                   "_non"
                   (trans v1 0 1)
                   "_non"
                   (trans v3 0 1)
          )
          (if (entlast)
            (ssadd (entlast) ss)
          )
          (command "_.UCS" "_P")
          (setq avl (cons (list v1 v2 v3) avl))
        )
      )
    )
    (while (> (getvar 'cmdactive) 0) (command ""))
    (foreach av avl
      (ssadd (3parc (car av) (cadr av) (caddr av) lay nor) ss)
    )
    (if avl
      (progn
        (command "_.UCS"
                 "_3P"
                 "_non"
                 (caar avl)
                 "_non"
                 (cadar avl)
                 "_non"
                 (caddar avl)
        )
        (command "_.PEDIT" "_M" ss "" "_J")
        (while (> (getvar 'cmdactive) 0) (command ""))
        (command "_.UCS" "_P")
      )
    )
    (setq vl nil
          dl nil
          dllg nil
          dllgr nil
          avl nil
          lg nil
    )
  )
  (setvar 'peditaccept pea)
  (princ)
)

(defun c:cslws2alws nil (c:convseglws2arcedlws))
(prompt "\nInvoke with \"cslws2alws\"")
(princ)

 HTH, Marko Ribar, d.i.a.

Marko Ribar, d.i.a. (graduated engineer of architecture)
Message 17 of 17
stevor
in reply to: zasanil

Not to the entire pline, just to segments created by ... more code. Unless already solved satisfactorily
S

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk Design & Make Report

”Boost