Topic: Delete arcs from pline - lisp request

[ziele_o2k]

Hi,

Could someone help me with lisp that will delete  arc segments from pline like in attached image

[ChrisCarlson]

You can utilize the "decurve" function of pedit to perform this task.

[ronjonp]

I think decurve would give a result more like this:

[ronjonp]

Here's a quick one to remove bulges:

Code - Auto/Visual Lisp: [Select]

1. (defun c:db (/ ss)
2.   (if (setq ss (ssget ":L" '((0 . "lwpolyline"))))
3.     (foreach pl (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
4.       (entmod (mapcar (function (lambda (x)
5.                                   (if (= 42 (car x))
6.                                     '(42 . 0.0)
7.                                     x
8.                                   )
9.                                 )
10.                       )
11.                       (entget pl '("*"))
12.               )
13.       )
14.     )
15.   )
16.   (princ)
17. )

[ziele_o2k]

As ronjonp mention, decurve will give another result.. And decurve is easy to achive.

[Lee Mac]

FWIW, you can use FILLET (with zero radius) on the surrounding segments to obtain the desired result.

[Lee Mac]

Should the new linear segments be tangent to the arc, or parallel to the surrounding linear segments?

For example, given the grey polyline, which of the following new vertices is correct, green or yellow?:



What if there are no surrounding linear segments?

[ziele_o2k]

Yellow one
Let's asume that first and last segment of pline are linear and arcs are always between two linear segments of pline.
I will write routine which will filter selection set, so only plines fitting to assumptions mentioned above will be proceed.

EDIT:
One more assumption, plines can't be closed

[MSTG007]

This is interesting... This happens more so than I think. lol.

[kirby]

Assuming this is converting Horizontal (highway) curves into linear segments between Points of Intersection (PI's):

• The tangent distance is always perpendicular to a radial drawn between the Arc centre and beginning point of circular curve (or ending point of circular curve)
• For deflection angles (or curve delta angles) > 180 degrees, split the arc into two (usually equal) and process normally.

See:
https://en.wikibooks.org/wiki/Fundamentals_of_Transportation/Horizontal_Curves

[ziele_o2k]

One more assumption, pline bulges are always made with round command.

[Lee Mac]

I wrote the following for fun as I enjoyed the challenge, but I believe you can obtain the same result from filleting the polyline with a zero-radius fillet.

Code - Auto/Visual Lisp: [Select]

1. ;; Decurve  -  Lee Mac
2. ;; Equivalent to applying a zero-radius fillet to a polyline with arc-segments
3.  
4. (defun c:decurve ( / enx hed idx int lst ocs rtn sel )
5.     (if (setq sel (ssget "_:L" '((0 . "LWPOLYLINE") (-4 . "<NOT") (-4 . "&=") (70 . 1) (-4 . "NOT>"))))
6.         (repeat (setq idx (sslength sel))
7.             (setq enx (entget (ssname sel (setq idx (1- idx))))
8.                   hed (reverse (member (assoc 38 enx) (reverse enx)))
9.                   ocs (cdr (assoc 210 enx))
10.                   lst (lwv-ptb enx)
11.                   rtn nil
12.             )
13.             (while (caddr lst)
14.                 (cond
15.                     (   (equal 0.0 (cdr (assoc 42 (car lst))) 1e-8)
16.                         (if (not (and rtn (ptonline (cdar rtn) (cdr (assoc 10 (car lst))) (cdr (assoc 10 (cadr lst))))))
17.                             (setq rtn (cons (assoc 10 (car lst)) rtn))
18.                         )
19.                     )
20.                     (   rtn
21.                         (if (setq int
22.                                 (apply 'inters
23.                                     (append
24.                                         (list (trans (cdar rtn) ocs 1))
25.                                         (mapcar '(lambda ( a b ) (trans (cdr (assoc 10 a)) ocs 1)) lst '(0 1 2))
26.                                        '(nil)
27.                                     )
28.                                 )
29.                             )
30.                             (setq rtn (cons (cons 10 (trans int 1 ocs)) rtn))
31.                             (setq rtn (cons (assoc 10 (car lst)) rtn))
32.                         )
33.                     )
34.                 )
35.                 (setq lst (cdr lst))
36.             )
37.             (while (and (cadr lst) (ptonline (cdar rtn) (cdr (assoc 10 (car lst))) (cdr (assoc 10 (cadr lst)))))
38.                 (setq lst (cdr lst))
39.             )
40.             (setq rtn (append (reverse rtn) (mapcar 'car lst)))
41.             (if (entmake
42.                     (append
43.                         (subst (cons 90 (length rtn)) (assoc 90 hed) hed)
44.                         (reverse rtn)
45.                         (list (cons 210 ocs))
46.                     )
47.                 )
48.                 (entdel (cdr (assoc -1 enx)))
49.             )
50.         )
51.     )
52.     (princ)
53. )
54. (defun ptonline ( pt1 pt2 pt3 )
55.     (equal (distance pt1 pt3) (+ (distance pt1 pt2) (distance pt2 pt3)) 1e-8)
56. )
57. (defun lwv-ptb ( lst )
58.     (if (setq lst (member (assoc 10 lst) lst))
59.         (cons (list (assoc 10 lst) (assoc 42 lst)) (lwv-ptb (cdr lst)))
60.     )
61. )
62. (princ)

[Grrr1337]

Damn Lee was faster, as always!

Leaving here my unfinished, failed attempt:

Code - Auto/Visual Lisp: [Select]

1. (defun test ( / e o L pL int nL eL )
2.   (setq e (car (entsel)))
3.   (setq o (vlax-ename->vla-object e))
4.   (setq L (vl-remove-if-not '(lambda (x) (eq "AcDbLine" (vla-get-ObjectName x))) (vlax-invoke o 'Explode)))
5.   (setq pL (mapcar '(lambda (x) (mapcar 'vlax-get (list x x) '(StartPoint EndPoint))) L))
6.   (setq int (mapcar '(lambda (a b) (apply 'inters (append a b '(())))) pL (cdr pL)))
7.   (setq nL
8.     (vl-sort
9.       (apply 'append
10.         (mapcar
11.           '(lambda (a)
12.             (mapcar '(lambda (b / p) (setq p (vlax-curve-getClosestPointTo a b)) (list (distance p b) b p a)) int)
13.           )
14.           L
15.         )
16.       )
17.       '(lambda (a b) (< (car a) (car b)))
18.     )
19.   )
20.   (repeat (length L)
21.     (setq eL (cons (car nL) eL))
22.     (setq nL (cdr nL))
23.   )
24.   (mapcar
25.     '(lambda (x / p o)
26.       (setq p (caddr x))
27.       (setq o (cadddr x))
28.       (cond
29.         ( (equal (vlax-get o 'StartPoint) p 1e-2) (vla-put-StartPoint o (vlax-3D-point (cadr x))) )
30.         ( (equal (vlax-get o 'EndPoint) p 1e-2) (vla-put-EndPoint o (vlax-3D-point (cadr x))) )
31.       ); cond
32.     ); lambda
33.     eL
34.   )
35. )

And another way to achieve Ron's result:

Code: [Select]

(setq e (car (entsel)))
(setq o (vlax-ename->vla-object e))
(setq n (vlax-curve-getEndParam o))
(repeat (fix n)
  (vla-SetBulge o (setq n (1- n)) 0)
); repeat    

Indeed this task is interesting!

[Sivaprasad]

defun c:decurve
Please anyone post a LISP routine to decurve the fillets with condition (Decurve if the radius within the prompted units. Large radius do not need to change) in all polylines in a selecionset.   

[xdcad]

defun c:decurve
Please anyone post a LISP routine to decurve the fillets with condition (Decurve if the radius within the prompted units. Large radius do not need to change) in all polylines in a selecionset.

http://www.theswamp.org/index.php?topic=58864.0