Jump to content

Lisp routine for changing a polyline into arcs and straight lines


bsimpson

Recommended Posts

I wonding if I would be able to change a polyline that has points generated along it at even spacings into objects that are arcs and straight lines. I am sure this will have to be a challenge to write as I don't think its a standard run of the mill lisp routine.o:)

Link to comment
Share on other sites

  • Replies 30
  • Created
  • Last Reply

Top Posters In This Topic

  • irneb

    10

  • bsimpson

    6

  • Lee Mac

    4

  • BlackBox

    4

Top Posters In This Topic

 

Irneb - the link is hilarious! Two of the funnier one's I skimmed (I didn't read them all), were these:

 

Dop-alcohol, liquor, or to fail a school year.

 

WTH!? :lmao:

 

Just now/Now now (Derived from Afrikaans, “nou- nou”) An immense source of amusement for foreigners - it means “very soon”, “eventually” or “never”. If someone says he will do something “just now/now now” it could be in 10 minutes, or tomorrow, or perhaps, he won’t do it at all!

 

 

The last one makes me think of that scene from Spaceballs:

 

6E40CD548E32E694CED420_Large.jpg

Link to comment
Share on other sites

Sorry guys I think you missed the point of the request he/she wants to explode the pline to multiple segments but with a given length of each segment.

 

Only question is line/arc join will they add up to segment length also?

Link to comment
Share on other sites

In that case, vlax-curve-getpointatdist + break at point combo *should* do the trick, no?

 

Certainly some good, incremental (entlast) storage is implied.

Link to comment
Share on other sites

Yes, or you could "recreate" each portion of the PL by obtaining those points from the vlax-curve functions. Only difficulty would be to calculate the new bulges for the arc sections if the point falls somewhere in the middle of an arc. But there is some code for this already. I think a lot of that I've found in this forum, usually Alan/Lee has given nice samples.

Link to comment
Share on other sites

Hello guys .

 

I did not understand the OP needs that well , so does they want to explode a polyline and recreate each portion of it like lines and arcs to be polyline

once again since the explode command would not keep their properties as polyline ?

 

Correct ? ? ..

 

Thanks

Link to comment
Share on other sites

Hello guys .

 

I did not understand the OP needs that well , so does they want to explode a polyline and recreate each portion of it like lines and arcs to be polyline

once again since the explode command would not keep their properties as polyline ?

 

Correct ? ? ..

 

Thanks

As I understand it (finally :oops:) the OP has a polyline (including some lines and arcs) which already has a block placed on it at specified distances (perhaps through the measure command). Now he wants to split the polyline at those points - as if he's used the Break command on each of those points.
Link to comment
Share on other sites

As I understand it (finally :oops:) the OP has a polyline (including some lines and arcs) which already has a block placed on it at specified distances (perhaps through the measure command). Now he wants to split the polyline at those points - as if he's used the Break command on each of those points.

 

So I am not the only one who thought it could be that goal. :D

 

But the title of the thread and the content of their first post nothings indicate to Block !!! :?

 

Lisp routine for changing a polyline into arcs and straight lines

 

Link to comment
Share on other sites

Lee spends too much time on these forums :oops:

 

1+

 

LoL - There's just something funny when someone talks about themselves in the third person. LoL

Link to comment
Share on other sites

bsimpson,

 

If I have understood correctly, the following should work for you:

 

([color=BLUE]defun[/color] c:test ( [color=BLUE]/[/color] _UniqueFuzz _SelectIf d e i g l m o s )
 [color=GREEN];; © Lee Mac 2011[/color]
 
 ([color=BLUE]defun[/color] _UniqueFuzz ( l fz )
   ([color=BLUE]if[/color] l
     ([color=BLUE]cons[/color] ([color=BLUE]car[/color] l)
       (_UniqueFuzz
         ([color=BLUE]vl-remove-if[/color] '([color=BLUE]lambda[/color] ( x ) ([color=BLUE]equal[/color] x ([color=BLUE]car[/color] l) fz)) ([color=BLUE]cdr[/color] l)) fz
       )
     )
   )
 )

 ([color=BLUE]defun[/color] _SelectIf ( msg pred [color=BLUE]/[/color] e ) ([color=BLUE]setq[/color] pred ([color=BLUE]eval[/color] pred))
   ([color=BLUE]while[/color]
     ([color=BLUE]progn[/color] ([color=BLUE]setvar[/color] 'ERRNO 0) ([color=BLUE]setq[/color] e ([color=BLUE]car[/color] ([color=BLUE]entsel[/color] msg)))
       ([color=BLUE]cond[/color]
         ( ([color=BLUE]=[/color] 7 ([color=BLUE]getvar[/color] 'ERRNO))
           ([color=BLUE]princ[/color] [color=MAROON]"\nMissed, Try again."[/color])
         )
         ( ([color=BLUE]eq[/color] 'ENAME ([color=BLUE]type[/color] e))
           ([color=BLUE]if[/color] ([color=BLUE]and[/color] pred ([color=BLUE]not[/color] (pred e)))
             ([color=BLUE]princ[/color] [color=MAROON]"\nInvalid Object Selected."[/color])
           )
         )
       )
     )
   )
   e
 )
 
 ([color=BLUE]if[/color]
   ([color=BLUE]and[/color]
     ([color=BLUE]setq[/color] e
       (_SelectIf [color=MAROON]"\nSelect LWPolyline: "[/color]
         ([color=BLUE]function[/color]
           ([color=BLUE]lambda[/color] ( x ) ([color=BLUE]eq[/color] [color=MAROON]"LWPOLYLINE"[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 ([color=BLUE]entget[/color] x)))))
         )
       )
     )
     ([color=BLUE]progn[/color]
       ([color=BLUE]initget[/color] 6)
       ([color=BLUE]setq[/color] s ([color=BLUE]getdist[/color] [color=MAROON]"\nSpecify Segment Length: "[/color]))
     )
   )
   ([color=BLUE]progn[/color]
     ([color=BLUE]setq[/color] i -1)
     ([color=BLUE]repeat[/color] ([color=BLUE]fix[/color] ([color=BLUE]1+[/color] ([color=BLUE]vlax-curve-getendparam[/color] e)))
       ([color=BLUE]setq[/color] l ([color=BLUE]cons[/color] ([color=BLUE]vlax-curve-getdistatparam[/color] e ([color=BLUE]setq[/color] i ([color=BLUE]1+[/color] i))) l))
     )
     ([color=BLUE]setq[/color] i 0 m ([color=BLUE]vlax-curve-getdistatparam[/color] e ([color=BLUE]vlax-curve-getendparam[/color] e)))
     ([color=BLUE]while[/color] ([color=BLUE]<[/color] ([color=BLUE]setq[/color] d ([color=BLUE]*[/color] ([color=BLUE]setq[/color] i ([color=BLUE]1+[/color] i)) s)) m)
       ([color=BLUE]setq[/color] l ([color=BLUE]cons[/color] d l))
     )
     ([color=BLUE]setq[/color] l ([color=BLUE]vl-sort[/color] (_UniqueFuzz l 1e- '[color=BLUE]<[/color])
           o ([color=BLUE]vlax-ename->vla-object[/color] e)
           g ([color=BLUE]entget[/color] e)
     )
     ([color=BLUE]mapcar[/color]
       ([color=BLUE]function[/color]
         ([color=BLUE]lambda[/color] ( a b [color=BLUE]/[/color] a1 bu c1 pa p1 p2 p3 p4 r1 )
           ([color=BLUE]if[/color]
             ([color=BLUE]and[/color]
               ([color=BLUE]setq[/color] p1 ([color=BLUE]vlax-curve-getpointatdist[/color] e a))
               ([color=BLUE]setq[/color] p2 ([color=BLUE]vlax-curve-getpointatdist[/color] e b))
             )
             ([color=BLUE]if[/color] ([color=BLUE]equal[/color] 0.0 ([color=BLUE]setq[/color] bu ([color=BLUE]vla-getbulge[/color] o ([color=BLUE]setq[/color] pa ([color=BLUE]fix[/color] ([color=BLUE]+[/color] 1e-6 ([color=BLUE]vlax-curve-getparamatdist[/color] e a)))))))
               ([color=BLUE]entmakex[/color]
                 ([color=BLUE]list[/color]
                   ([color=BLUE]cons[/color] 0 [color=MAROON]"LINE"[/color])
                   ([color=BLUE]assoc[/color] 8 g)
                   ([color=BLUE]cond[/color] ( ([color=BLUE]assoc[/color] 62 g) ) ( ([color=BLUE]cons[/color] 62 256) ))
                   ([color=BLUE]cond[/color] ( ([color=BLUE]assoc[/color] 39 g) ) ( ([color=BLUE]cons[/color] 39 0.0) ))
                   ([color=BLUE]cond[/color] ( ([color=BLUE]assoc[/color]  6 g) ) ( ([color=BLUE]cons[/color] 6 [color=MAROON]"ByLayer"[/color]) ))
                   ([color=BLUE]cons[/color] 10 p1)
                   ([color=BLUE]cons[/color] 11 p2)
                 )
               )
               ([color=BLUE]progn[/color]
                 ([color=BLUE]setq[/color] p3 ([color=BLUE]vlax-curve-getpointatparam[/color] e pa)
                       p4 ([color=BLUE]vlax-curve-getpointatparam[/color] e ([color=BLUE]1+[/color] pa))
                       a1 ([color=BLUE]*[/color] 2.0 ([color=BLUE]atan[/color] bu))
                       r1 ([color=BLUE]/[/color] ([color=BLUE]distance[/color] p3 p4) ([color=BLUE]*[/color] 2.0 ([color=BLUE]sin[/color] a1)))
                       c1 ([color=BLUE]polar[/color] p3 ([color=BLUE]+[/color] ([color=BLUE]-[/color] ([color=BLUE]/[/color] [color=BLUE]pi[/color] 2.) a1) ([color=BLUE]angle[/color] p3 p4)) r1)
                 )
                 ([color=BLUE]entmakex[/color]
                   ([color=BLUE]list[/color]
                     ([color=BLUE]cons[/color] 0 [color=MAROON]"ARC"[/color])
                     ([color=BLUE]assoc[/color] 8 g)
                     ([color=BLUE]cond[/color] ( ([color=BLUE]assoc[/color] 62 g) ) ( ([color=BLUE]cons[/color] 62 256) ))
                     ([color=BLUE]cond[/color] ( ([color=BLUE]assoc[/color] 39 g) ) ( ([color=BLUE]cons[/color] 39 0.0) ))
                     ([color=BLUE]cond[/color] ( ([color=BLUE]assoc[/color]  6 g) ) ( ([color=BLUE]cons[/color] 6 [color=MAROON]"ByLayer"[/color]) ))
                     ([color=BLUE]cons[/color] 10 c1)
                     ([color=BLUE]cons[/color] 40 ([color=BLUE]abs[/color] r1))
                     ([color=BLUE]cons[/color] 50 ([color=BLUE]if[/color] ([color=BLUE]minusp[/color] bu) ([color=BLUE]angle[/color] c1 p2) ([color=BLUE]angle[/color] c1 p1)))
                     ([color=BLUE]cons[/color] 51 ([color=BLUE]if[/color] ([color=BLUE]minusp[/color] bu) ([color=BLUE]angle[/color] c1 p1) ([color=BLUE]angle[/color] c1 p2)))
                   )
                 )
               )
             )
           )
         )
       )
       l ([color=BLUE]cdr[/color] l)
     )
     ([color=BLUE]entdel[/color] e)
   )
 )
 ([color=BLUE]princ[/color])
)
([color=blue]vl-load-com[/color]) ([color=blue]princ[/color])

Link to comment
Share on other sites

Well guys I think I need explain firstly I am a he and secondly it needs more than just the explode lisp routine. I have a programme that outputs a cad polyline in 2010 format by plotting the polyline at even spaces. The polyline follows a path of straight lines and arcs and I need to convet the polyline into objects of straight lines and arcs. The staight lines should be between and not segmented.Thanks Bsimpson I have attached a sample at http://mbf.me/Yn4xF

Link to comment
Share on other sites

OK, that appears to be a polyline "converted" from a spline. There's no arcs inside it as yet - only very short lines. So what you're "actually" after is a polyline simplification routine?

 

Something which does similar to this: http://www.cs.sunysb.edu/~algorith/files/simplifying-polygons.shtml

 

If this is actually what you want, then I'm sorry - none of use figured out that from your OP.

Link to comment
Share on other sites

bsimpson,

 

If I have understood correctly, the following should work for you:

 

([color=BLUE]defun[/color] c:test ( [color=BLUE]/[/color] _UniqueFuzz _SelectIf d e i g l m o s )
[color=GREEN];; © Lee Mac 2011[/color]

([color=BLUE]defun[/color] _UniqueFuzz ( l fz )
([color=BLUE]if[/color] l
([color=BLUE]cons[/color] ([color=BLUE]car[/color] l)
(_UniqueFuzz
([color=BLUE]vl-remove-if[/color] '([color=BLUE]lambda[/color] ( x ) ([color=BLUE]equal[/color] x ([color=BLUE]car[/color] l) fz)) ([color=BLUE]cdr[/color] l)) fz
)
)
)
)

([color=BLUE]defun[/color] _SelectIf ( msg pred [color=BLUE]/[/color] e ) ([color=BLUE]setq[/color] pred ([color=BLUE]eval[/color] pred))
([color=BLUE]while[/color]
([color=BLUE]progn[/color] ([color=BLUE]setvar[/color] 'ERRNO 0) ([color=BLUE]setq[/color] e ([color=BLUE]car[/color] ([color=BLUE]entsel[/color] msg)))
([color=BLUE]cond[/color]
( ([color=BLUE]=[/color] 7 ([color=BLUE]getvar[/color] 'ERRNO))
([color=BLUE]princ[/color] [color=MAROON]"\nMissed, Try again."[/color])
)
( ([color=BLUE]eq[/color] 'ENAME ([color=BLUE]type[/color] e))
([color=BLUE]if[/color] ([color=BLUE]and[/color] pred ([color=BLUE]not[/color] (pred e)))
([color=BLUE]princ[/color] [color=MAROON]"\nInvalid Object Selected."[/color])
)
)
)
)
)
e
)

([color=BLUE]if[/color]
([color=BLUE]and[/color]
([color=BLUE]setq[/color] e
(_SelectIf [color=MAROON]"\nSelect LWPolyline: "[/color]
([color=BLUE]function[/color]
([color=BLUE]lambda[/color] ( x ) ([color=BLUE]eq[/color] [color=MAROON]"LWPOLYLINE"[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 ([color=BLUE]entget[/color] x)))))
)
)
)
([color=BLUE]progn[/color]
([color=BLUE]initget[/color] 6)
([color=BLUE]setq[/color] s ([color=BLUE]getdist[/color] [color=MAROON]"\nSpecify Segment Length: "[/color]))
)
)
([color=BLUE]progn[/color]
([color=BLUE]setq[/color] i -1)
([color=BLUE]repeat[/color] ([color=BLUE]fix[/color] ([color=BLUE]1+[/color] ([color=BLUE]vlax-curve-getendparam[/color] e)))
([color=BLUE]setq[/color] l ([color=BLUE]cons[/color] ([color=BLUE]vlax-curve-getdistatparam[/color] e ([color=BLUE]setq[/color] i ([color=BLUE]1+[/color] i))) l))
)
([color=BLUE]setq[/color] i 0 m ([color=BLUE]vlax-curve-getdistatparam[/color] e ([color=BLUE]vlax-curve-getendparam[/color] e)))
([color=BLUE]while[/color] ([color=BLUE]<[/color] ([color=BLUE]setq[/color] d ([color=BLUE]*[/color] ([color=BLUE]setq[/color] i ([color=BLUE]1+[/color] i)) s)) m)
([color=BLUE]setq[/color] l ([color=BLUE]cons[/color] d l))
)
([color=BLUE]setq[/color] l ([color=BLUE]vl-sort[/color] (_UniqueFuzz l 1e- '[color=BLUE]<[/color])
o ([color=BLUE]vlax-ename->vla-object[/color] e)
g ([color=BLUE]entget[/color] e)
)
([color=BLUE]mapcar[/color]
([color=BLUE]function[/color]
([color=BLUE]lambda[/color] ( a b [color=BLUE]/[/color] a1 bu c1 pa p1 p2 p3 p4 r1 )
([color=BLUE]if[/color]
([color=BLUE]and[/color]
([color=BLUE]setq[/color] p1 ([color=BLUE]vlax-curve-getpointatdist[/color] e a))
([color=BLUE]setq[/color] p2 ([color=BLUE]vlax-curve-getpointatdist[/color] e b))
)
([color=BLUE]if[/color] ([color=BLUE]equal[/color] 0.0 ([color=BLUE]setq[/color] bu ([color=BLUE]vla-getbulge[/color] o ([color=BLUE]setq[/color] pa ([color=BLUE]fix[/color] ([color=BLUE]+[/color] 1e-6 ([color=BLUE]vlax-curve-getparamatdist[/color] e a)))))))
([color=BLUE]entmakex[/color]
([color=BLUE]list[/color]
([color=BLUE]cons[/color] 0 [color=MAROON]"LINE"[/color])
([color=BLUE]assoc[/color] 8 g)
([color=BLUE]cond[/color] ( ([color=BLUE]assoc[/color] 62 g) ) ( ([color=BLUE]cons[/color] 62 256) ))
([color=BLUE]cond[/color] ( ([color=BLUE]assoc[/color] 39 g) ) ( ([color=BLUE]cons[/color] 39 0.0) ))
([color=BLUE]cond[/color] ( ([color=BLUE]assoc[/color] 6 g) ) ( ([color=BLUE]cons[/color] 6 [color=MAROON]"ByLayer"[/color]) ))
([color=BLUE]cons[/color] 10 p1)
([color=BLUE]cons[/color] 11 p2)
)
)
([color=BLUE]progn[/color]
([color=BLUE]setq[/color] p3 ([color=BLUE]vlax-curve-getpointatparam[/color] e pa)
p4 ([color=BLUE]vlax-curve-getpointatparam[/color] e ([color=BLUE]1+[/color] pa))
a1 ([color=BLUE]*[/color] 2.0 ([color=BLUE]atan[/color] bu))
r1 ([color=BLUE]/[/color] ([color=BLUE]distance[/color] p3 p4) ([color=BLUE]*[/color] 2.0 ([color=BLUE]sin[/color] a1)))
c1 ([color=BLUE]polar[/color] p3 ([color=BLUE]+[/color] ([color=BLUE]-[/color] ([color=BLUE]/[/color] [color=BLUE]pi[/color] 2.) a1) ([color=BLUE]angle[/color] p3 p4)) r1)
)
([color=BLUE]entmakex[/color]
([color=BLUE]list[/color]
([color=BLUE]cons[/color] 0 [color=MAROON]"ARC"[/color])
([color=BLUE]assoc[/color] 8 g)
([color=BLUE]cond[/color] ( ([color=BLUE]assoc[/color] 62 g) ) ( ([color=BLUE]cons[/color] 62 256) ))
([color=BLUE]cond[/color] ( ([color=BLUE]assoc[/color] 39 g) ) ( ([color=BLUE]cons[/color] 39 0.0) ))
([color=BLUE]cond[/color] ( ([color=BLUE]assoc[/color] 6 g) ) ( ([color=BLUE]cons[/color] 6 [color=MAROON]"ByLayer"[/color]) ))
([color=BLUE]cons[/color] 10 c1)
([color=BLUE]cons[/color] 40 ([color=BLUE]abs[/color] r1))
([color=BLUE]cons[/color] 50 ([color=BLUE]if[/color] ([color=BLUE]minusp[/color] bu) ([color=BLUE]angle[/color] c1 p2) ([color=BLUE]angle[/color] c1 p1)))
([color=BLUE]cons[/color] 51 ([color=BLUE]if[/color] ([color=BLUE]minusp[/color] bu) ([color=BLUE]angle[/color] c1 p1) ([color=BLUE]angle[/color] c1 p2)))
)
)
)
)
)
)
)
l ([color=BLUE]cdr[/color] l)
)
([color=BLUE]entdel[/color] e)
)
)
([color=BLUE]princ[/color])
)
([color=blue]vl-load-com[/color]) ([color=blue]princ[/color])

dear sir,

error in acad2012

Command: ; error: bad argument type: numberp: nil

 

Link to comment
Share on other sites

That lisp of lee's is changing the PL into lines and acrs (individual ones), then splitting them at a given distance. I'm not sure it's doing what you're after.

 

Perhaps something in this direction would suffice: http://www.cadtutor.net/forum/showthread.php?25098-reduce-No.-of-points

 

At least it makes the PL less dense. For the straight-line portions - the OverKill command might help. It's the curves which aren't too easy. Do you want an "accurate" change into lines & arcs? Or something which "smoothes" the lines into a closest matching arc? Should the arc pass through the endpoints of each line segment, or the middle of the lines. If not exactly accurate, how would you like to allow for a fuzz factor?

Link to comment
Share on other sites

dear sir,

error in acad2012

 

It seemed to work in my tests, but in any case, since I have misunderstood the task at hand, I will exit this thread at this point.

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...