Fillet in polyline two lines or with other words change the fillet radius

[eakos1]

I want to write an lisp program which can go through a polyline if the fillet radius is bigger than 3 will change the radius with a given value eg. 0.1 mm. 

I tried to use the fillet command but I couldn't get it work. I can read the points from the polyline and if I tried the p2 p3 points with fillet an error message popped up - cannot fillet. 

Is it possible somehow to get the names of the straight lines from polyline? Maybe with the names the fillet could work. 

I tried to select the straight lines with fence selection creating theoretical perpendicular crossing lines but it also give me the failure message: invalid selection.

(defun c:RADIUS3 (/	     *error*	width	   radius     aselection sslen	    counter    data	  typ
		  angarc     bulge	element	   l	      name	 obj	    p1	       p2	  p3
		  p4	     p1a	p2a	   p3a	      p4a	 ss1	    ss2	       r	  segmentindex
		  numberPolyArc		dbr3	   number_of_arcs	 p1p2_angle p3p4_angle radius_change
		 )

   -------------------------------------------------------------------------
   (vl-load-com)
   (setq width 1)   ;width o the arc segments in the polyline
   (setq radius 2.99999) ;the defined smallest radius, ARC with smaller radius hast to be selected
   (setq radius_change 0.1)
   (setq selection (ssget))
   (setq sslen (sslength selection))
   (setq counter 0)
   (setq numberPolyArc 0)
   (setq dbr3 0)    ;counter for ARCs with smaller radius then 3 mm
   (setq number_of_arcs 0)

   -------------------------------------------------------------------------

   (if
      (/= sslen 0)
	(repeat	sslen

	   (setq name (ssname selection counter))
	   (setq data (entget name))
	   (setq typ (cdr (assoc 0 data)))
	   ----------------------------------------------------------------------------------

	   (if (or (= typ "POLYLINE") (= typ "LWPOLYLINE"))
	      (progn
		 (setq element (fix (vlax-curve-getendparam name))) ;number of segments of the polyline
		 (setq segmentindex -1)
		 (setq obj (vlax-ename->vla-object name))

		 (repeat (- element 1)
		    (setq p1 (vlax-curve-getpointatparam name (setq segmentindex (1+ segmentindex))))
		    (setq bulge1 (vla-getbulge (vlax-ename->vla-object name) segmentindex))
		    (setq p2 (vlax-curve-getpointatparam name (+ 1 segmentindex)))
		    (setq bulge2 (vla-getbulge (vlax-ename->vla-object name) (+ 1 segmentindex)))
		    (setq p3 (vlax-curve-getpointatparam name (+ 2 segmentindex)))
		    (setq bulge3 (vla-getbulge (vlax-ename->vla-object name) (+ 2 segmentindex)))
		    (setq p4 (vlax-curve-getpointatparam name (+ 3 segmentindex)))
		    (setq bulge4 (vla-getbulge (vlax-ename->vla-object name) (+ 3 segmentindex)))
		    (command "point" p1)
		    (command "point" p2)
		    (command "point" p3)
		    (command "point" p4)

		    ;print the co-ordinates
		    ;(princ (strcat " bulge = " (rtos bulge))) ;print the bulge

		    -------------------------------------------------------------------------

		    ;If radius small then change the width
		    (if	(and (= bulge1 0) (= bulge3 0) (/= bulge2 0))
		       (progn
			  (setq l (distance p2 p3))
			  (setq angarc (* 4.0 (atan bulge2)))
			  (setq r (abs (/ (/ l 2) (sin (/ angarc 2.0)))))
			  (princ (strcat " r = " (rtos r)))
			  (if (>= r radius)
			     (progn
;;;				(setq p1 (getpoint))
;;;				(setq p2 (getpoint p1))
;;;				(command "line" p1 p2 "")



				(setq p1p2_angle (angle p1 p2))
				(setq p1a (polar (polar p1  p1p2_angle ( / (distance p1 p2) 2)) (+ p1p2_angle (angtof "90")) 1))
				(setq p2a (polar (polar p1  p1p2_angle ( / (distance p1 p2) 2)) (+ p1p2_angle (angtof "270")) 1))
				(setq ss1 (ssget "F" (list p1a p2a)))
				(command "line" p1a p2a "")

				(setq p3p4_angle (angle p3 p4))
				(setq p3a (polar (polar p3 p3p4_angle ( / (distance p3 p4) 2)) (+ p3p4_angle (angtof "90")) 1))
				(setq p4a (polar (polar p3 p3p4_angle ( / (distance p3 p4) 2)) (+ p3p4_angle (angtof "270")) 1))
				(setq ss2 (ssget "F" (list p3a p4a)))
				(command "line" p3a p4a "")

;;;				(command "point" (polar p1 p1p2_angle ( / (distance p1 p2) 2)) )
;;;				(command "point" (polar p3 p3p4_angle ( / (distance p3 p4) 2)) )


				(setq pt1 (cadr (cadddr (car (ssnamex ss1 0))))
				      pt2 (cadr (cadddr (car (ssnamex ss2 0))))
					)
				(command "point" pt1)
		                (command "point" pt2)
				
				(princ pt1)
				(princ pt2)

				(setq r (+ r radius_change))
				(setvar "FILLETRAD" r)

				(vla-setwidth obj (+ 1 segmentindex) width width)
				(command "_.fillet" pt1 pt2)

				(setq numberPolyArc (1+ numberPolyArc))
			     ) ;end progn
			     (vla-setwidth obj (+ 1 segmentindex) 0 0)
			  ) ;end if
		       ) ;end progn
		    ) ;end if

		    -------------------------------------------------------------------------
		 )  ;end repeat
	      )	    ;progn
	   )	    ;if
	   ----------------------------------------------------------------------------------
	   (setq counter (+ 1 counter))

	)	    ;end repeat
   )		    ;end if sslen

   (princ)
)

[Kent1Cooper]

If you're using vertex locations at either end of an arc segment as the pick points in a Fillet command, I expect it's going to "see" either the upstream or downstream segment at each vertex picked, which would mean one or the other of the segments it "sees" will always be the arc, and that would explain the error.  You could instead use points that you know will be in the middle of the adjacent line segments, for example:

(setq p1A (vlax-curve-getpointatparam name (+ 0.5 segmentindex)))
(setq p3A (vlax-curve-getpointatparam name (+ 2.5 segmentindex)))

[john.uhden]

What @Kent1Cooper said is quite sound, but for fun you could compute all the points and bulges and vlax-put the desired values, thereby avoiding the "unknowns" of how a command might react.

Wait a second.  If you don't mind having all the radii the same, you could fillet polyline.

[eakos1]

Thanks for the suggestion. At first with your suggestion not worked for me. But finally I figured out that the problem was that I let the program draw points and therefore the fillet wanted to fillet the points and not the lines so I get the failure message.  😙 🤤 Removing this from the program also my original code works. 😀

But with your suggestion it is more simple. 

[eakos1]

Hello,

now my program is working but just in certain circumstances. I hardly believe that the command fillet depend on how the zoom is on the screen 😮 ⁉️ If I have short waves and can zoom them on the full window it is working but if the zoom is smaller it gives error message. It seams if the lines are too small on the screen the fillet is not working.

So the fillet works on the screen and not in the database ???

Unbelievable. 

So your saying that I has to somehow compute the new points and the bulge and write them into the database?

Is there no simpler way? 

And how? There are vlax-curve-getpointatparam and vla-getbulge commands. But the opposites are not existing

vlax-curve-putpointatparam and vla-putbulge.

If I look at the help there is vla-setbulge is existing. This is OK. 

But the points, the vertexes?

[ВeekeeCZ]

---

@eakos1 wrote:

Hello,

now my program is working but just in certain circumstances. I hardly believe that the command fillet depend on how the zoom is on the screen 😮 ⁉️ ...

---

Turn off osnaps!

[john.uhden]

It may not work if you zoom in because the pickbox covers less area and may
miss.
If however your polyline exists (which it must), then get its object name
or ename (let's say e), then (setq p1 (vlax-curve-getclosestpointto e p1))
and same for p2. That way you can't miss.
As to all the mathematical code, I have no problem because I come from the
days before all this VL stuff and even back to when we computed
roadway geometry using a slide rule and book of sines and cosines and
tangents, but it can be a lot of work.

[eakos1]

Here is my code and an file with waves. 

(defun c:RADIUS3 (/	    *error*   width	radius	  radius_change	      selection	sslen	  counter   data
		  typ	    angarc    bulge1	bulge2	  bulge3    bulge4    element	l	  name	    obj
		  p1	    p2	      p3	p4	  p1a	    p2a	      p3a	p4a	  pt1	    pt2
		  r	    segmentindex	numberPolyArc	    osm
		 )

   -------------------------------------------------------------------------
		    ;error handling
   (defun *error* (Msg)
      (cond
	 ((or (not Msg)
	      (member
		 Msg
		 '("console break" "Function cancelled" "quit / exit abort")
	      )
	  )	    ;close or
	 )	    ;close condition, no message to display
	 ((princ (strcat "\nError: " Msg))) ;else display message
      )		    ;close cond
      (princ)
   )		    ;close defun *Error*

   -------------------------------------------------------------------------

   (command "_.UNDO" "_BEgin")
   (vl-load-com)
   ;(setq osm (getvar 'OSMODE))
   ;(setvar 'OSMODE (logior 16384 osm))


   (setq width 1)   ;width o the arc segments in the polyline
   (setq radius 2.99999) ;the defined smallest radius, ARC with smaller radius hast to be selected
   (setq radius_change
	   (cond ((getreal "\nGive the change in the radius<0.05>:"))
		 (0.05)
	   )
   )
   (setq selection (ssget))
   (setq sslen (sslength selection))
   (setq counter 0)
   (setq numberPolyArc 0)

   -------------------------------------------------------------------------

   (if
      (/= sslen 0)
	(repeat	sslen

	   (setq name (ssname selection counter))
	   (setq data (entget name))
	   (setq typ (cdr (assoc 0 data)))
	   ----------------------------------------------------------------------------------

	   (if (or (= typ "POLYLINE") (= typ "LWPOLYLINE"))
	      (progn
		 (setq element (fix (vlax-curve-getendparam name))) ;number of segments of the polyline
		 (setq segmentindex -1)
		 (setq obj (vlax-ename->vla-object name))

		 (repeat (- element 2)
		    (setq p1 (vlax-curve-getpointatparam name (setq segmentindex (1+ segmentindex))))
		    (setq bulge1 (vla-getbulge (vlax-ename->vla-object name) segmentindex))
		    (setq p2 (vlax-curve-getpointatparam name (+ 1 segmentindex)))
		    (setq bulge2 (vla-getbulge (vlax-ename->vla-object name) (+ 1 segmentindex)))
		    (setq p3 (vlax-curve-getpointatparam name (+ 2 segmentindex)))
		    (setq bulge3 (vla-getbulge (vlax-ename->vla-object name) (+ 2 segmentindex)))
		    (setq p4 (vlax-curve-getpointatparam name (+ 3 segmentindex)))
		    (setq bulge4 (vla-getbulge (vlax-ename->vla-object name) (+ 3 segmentindex)))
 
		    -------------------------------------------------------------------------

		    ;If radius small then change the width
		    (if	(and (= bulge1 0) (= bulge3 0) (/= bulge2 0))
		       (progn
			  (setq l (distance p2 p3))
			  (setq angarc (* 4.0 (atan bulge2)))
			  (setq r (abs (/ (/ l 2) (sin (/ angarc 2.0)))))
			  (princ (strcat " r = " (rtos r)))

			  ------------

			  (if (and (< radius_change 0) (>= r (+ radius (abs radius_change))))
			     (progn

				(setq pt1 (vlax-curve-getpointatparam name (+ 0.5 segmentindex)))
				(setq pt2 (vlax-curve-getpointatparam name (+ 2.5 segmentindex)))

				(setq r (+ r radius_change))
				(setvar "FILLETRAD" r)

				(command "_.fillet" pt1 pt2)
				(vla-setwidth obj (+ 1 segmentindex) width width)

				(setq numberPolyArc (1+ numberPolyArc))
			     ) ;end progn
			  ) ;end if

			  (if (and (> radius_change 0) (> (distance p1 p2) 1) (> (distance p3 p4) 1))
			     (progn

				(setq pt1 (vlax-curve-getpointatparam name (+ 0.5 segmentindex)))
				(setq pt2 (vlax-curve-getpointatparam name (+ 2.5 segmentindex)))

				(setq r (+ r radius_change))
				(setvar "FILLETRAD" r)

				(command "_.fillet" pt1 pt2)
				(vla-setwidth obj (+ 1 segmentindex) width width)

				(setq numberPolyArc (1+ numberPolyArc))
			     ) ;end progn
		    ;(vla-setwidth obj (+ 1 segmentindex) 0 0)
			  ) ;end if

			  -------------------

		       ) ;end progn
		    ) ;end if

		    -------------------------------------------------------------------------
		 )  ;end repeat
	      )	    ;progn
	   )	    ;if
	   ----------------------------------------------------------------------------------

	   (setq counter (+ 1 counter))

	)	    ;end repeat
   )		    ;end if sslen
     (princ
      (strcat "\nNumber of ARC's changed in the polylines: " (itoa numberPolyArc))
   )
   (terpri)
   (command "_.UNDO" "_End")
   ;(setvar 'OSMODE osm)

   (princ)
)		    ;defun

[eakos1]

I don't understand why would it help because I already took the points through the name of the polyline. 

But I added this two line to the code but doesn't helped. 

(setq pt1 (vlax-curve-getpointatparam name (+ 0.5 segmentindex)))
(setq pt2 (vlax-curve-getpointatparam name (+ 2.5 segmentindex)))

(setq pt1 (vlax-curve-getclosestpointto name pt1))
(setq pt2 (vlax-curve-getclosestpointto name pt2))

(setq r (+ r radius_change))
(setvar "FILLETRAD" r)

(command "_.fillet" pt1 pt2)

To calculate the new points and bulge is not a problem for me but how to change the points to the new ones in the polyline does. 

For bulge it is vla-setbulge but for the points?

[ВeekeeCZ]

To calculate the new points and bulge is not a problem for me but how to change the points to the new ones in the polyline does. 

This is the only way to go! 

NO FILLET, NO COMMANDS.

[ВeekeeCZ]

Here's the way how to modify a polyline. Do you need to add comments?

;------------------------------------------------------------------------------------------------------------
(defun :PLVrxPart (en vr1 vr2 new / CAB:group_on i edn vrs vrskeep) ;vrx number
  
  ;;  by CAB group on elements  -- (group_on '(A B C D E F G) 3) -- Result ((A B C) (D E F) (G nil nil))
  (defun CAB:group_on (inlst n / outlst i subLst)
    (while inlst
      (setq i -1 subLst nil)
      (while (< (setq i (1+ i)) n) (setq subLst (cons (nth i inlst) sublst)))
      (setq outlst (cons (reverse sublst) outlst))
      (repeat n (setq inlst (cdr inlst))))
    (reverse outlst))
  
  ; ---- main
  (setq ed 	(entget en)
	vr2 	(min vr2 (vlax-curve-getEndParam en))
	vrs	(vl-remove-if-not '(lambda (x) (vl-position (car x) '(40 41 42 10))) ed)
	edn	(vl-remove-if 	  '(lambda (x) (vl-position (car x) '(40 41 42 10 91))) ed)
	vrs	(CAB:group_on vrs 4)
	i 	-1)
  (repeat (1+ (length vrs))
    (if (<= vr1 	(setq i (1+ i))		vr2)
      (setq vrskeep (cons (nth i vrs) vrskeep))))
  (mapcar (function (lambda (x) (setq edn (append edn x)))) (reverse vrskeep))
  (setq edn (subst (cons  90  (length vrskeep))
		   (assoc 90 edn)
		   edn))
  (if new
    (entmakex edn)
    (cdr (assoc -1 (entmod  edn)))))

[ВeekeeCZ]

Your algorithm would be different... here's what would I do.

Use while to go through all the vertices (not repeat).

Build a new list of vertices.

If 42 (bulge) is 0 or less than your value, add current and next vertex to the new list.

If is more, calculate new 10 (coords) and 42 of current vrx, also 10 of next vrx (if it's straight).

Both vertices remove from the old list of vertices (cddr vrs)

Issue: If the current vertex is an arc and next is also an arc, and you need to change the current one, better add an extra straight segment in between. Otherwise, the math gets over complicated. 

Good luck.

[Sea-Haven]

Pick start pick then pick end all done look for "Insulation Lisp"  so many examples will draw the waves I have a like 5 different ones they are plines with bulge ZigZag etc Sorry copyrighted.

[eakos1]

Hello, thanks for the code. More or less I understand how it works but it seems a little bit complicated to me. 

But I could figure out a very simple code. It is already works for me as test program. It changes all the bulges between two lines - but only by LWPolyline.  But I don't care. 

Now I have to figure out the calculation of the new points and new bulge and that's it.  

(defun C:R_change (/ e ed i vt p0 p-1 p-2 p-3 bulge bulge0 bulge-1 bulge-2 bulge-3 X Y ed_eredeti b1 b2 b3 b4)

   (vl-load-com)
   (setq e  (car (entsel))
	 ed (entget e)
   )
   (setq ed_eredeti ed)
   (setq i 0)

   (if (= (cdr (assoc 0 ed)) "LWPOLYLINE")
      (repeat (length ed)
	 (if (= (car (nth i ed)) 10) ;if item is a vertex
	    (progn
	       (setq vt (cdr (nth i ed))) ; get vertex values
	       (setq p-3 p-2 ;collecting and store the current and three previous points
		     p-2 p-1
		     p-1 p0
		     p0	 vt
	       )
	       (setq bulge (cdr (nth (+ i 3) ed))) ; get vertex values
	       (setq bulge-3 bulge-2 ;collecting and store the current and three previous bulges
		     bulge-2 bulge-1
		     bulge-1 bulge0
		     bulge0  bulge
	       )
	       (if (and (= bulge-1 0) (= bulge-3 0) (/= bulge-2 0)) ;checking if between two lines is an ARC
		  (progn

		     ----------------------------
		     ;Here will be calculated the new points and new bulge

		     ----------------------------

		     (setq bulge (+ bulge-2 0.1))
		     (setq ed (subst (cons 42 bulge) (nth (- i 7) ed) ed))

		     (entmod ed) ; update the drawing
		  )
	       )

	    )	    ;progn
	 )	    ;if
	 (setq i (1+ i))
      )		    ;repeat
   )		    ;if
   (princ)
)		    ;end defun

[john.uhden]

@eakos1 

1.  For each bulge you intersect the previous straight tangent with the straight tangent (we can't call it PI or P.I., so let's call it P_I).

2.  Calculate the delta between the two tangents (see function below)

3.  Calculate the new arc tangent from the new radius 

     T=R*tan (delta / 2)  [remember that tan = sin/cos]

4.  solve for the new PC (beginning of arc) and PT (end of arc) by using the polar function and the T distance from the P_I.

5.  If it's an LWPolyline, you can subst each new point for the old and entmod, otherwise we will have to get into using the 'Coordinates property of the vla-object.  If you don't know how, I can show you.

;;-----------------------------------------------------------------------
;; This function returns the deflection angle (in radians) of two angles:
;;
(defun @delta (a1 a2)
  (cond
    ((> a1 (+ a2 pi))
      (setq a2 (+ a2 pi pi))
    )
    ((> a2 (+ a1 pi))
      (setq a1 (+ a1 pi pi))
    )
  )
  (- a2 a1)
)

[ВeekeeCZ]

Well, here's the quick core function. I did not bother with calculations much and not sure if @john.uhden 's delta calc is what's missing.

Also, as matter of fact, you don't need to change bulges at all.

The code as is only works right on rectangles.

(defun c:Prad (/ CAB:group_on LM:BCen LM:BRad e r d vrs cor vrc c40 c41 c42 c10 n40 n41 n42 n10 d10 m10 new)   ; c10 current vertex, n10 next to current, d10 newly calculated c10, m10 new for n10
  
  ;;  by CAB group on elements  -- (group_on '(A B C D E F G) 3) -- Result ((A B C) (D E F) (G nil nil))
  (defun CAB:group_on (inlst n / outlst i subLst)
    (while inlst
      (setq i -1 subLst nil)
      (while (< (setq i (1+ i)) n) (setq subLst (cons (nth i inlst) sublst)))
      (setq outlst (cons (reverse sublst) outlst))
      (repeat n (setq inlst (cdr inlst))))
    (reverse outlst))
  
  ; by Lee Mac
  (defun LM:BCen ( p1 p2 b ) (polar p1 (+ (angle p1 p2) (- (/ pi 2) (* 2 (atan b)))) (/ (* (distance p1 p2) (1+ (* b b))) 4 b)))
  (defun LM:BRad ( p1 p2 b ) (/ (* (distance p1 p2) (1+ (* b b))) 4 (abs b)))
  
  ; -------------------------------------------------------------------------------------------------------------------------------
  
  (if (and (setq e (car (entsel "Select pl: ")))
	   (setq r 0.1) ; new radius
	   (setq m 3.0) ; limit rad
	   (setq d (entget e))
	   (or (= "LWPOLYLINE" (cdr (assoc 0 d)))
	       (prompt "\nError: Wrong selection."))
	   (setq vrs (mapcar 'cdr (vl-remove-if-not '(lambda (x) (vl-position (car x) '(10 40 41 42))) d)))
	   (setq vrs (CAB:group_on vrs 4))
	   (setq cor (vl-remove-if '(lambda (x) (vl-position (car x) '(10 40 41 42 91))) d))
	   )
    (while (setq vrc (car vrs))
      (setq vrs (cdr vrs))
      (mapcar 'set '(c10 c40 c41 c42) vrc)
      (if (= c42 0)
	(setq new (cons vrc new))
	(if (setq vrn (car vrs))
	  (progn
	    (setq vrs (cdr vrs))
	    (mapcar 'set '(n10 n40 n41 n42) vrn)
	    (setq cen (LM:Bcen c10 n10 c42)
		  rad (LM:Brad c10 n10 c42))
	    (if (<= rad m)
	      (setq new (cons vrn (cons vrc new)))
	      (setq d10 (polar c10 (rem (+ (angle cen c10) (* (/ c42 (abs c42)) (/ pi 2)) (* 2 pi)) (* 2 pi)) (- rad r)) ; (- rad r)  only works for 90° ang.
		    m10 (polar n10 (rem (+ (angle n10 cen) (* (/ c42 (abs c42)) (/ pi 2)) (* 2 pi)) (* 2 pi)) (- rad r))
		    new (cons (list m10 n40 n41 n42) (cons (list d10 c40 c41 c42) new)))))
	  (setq new (cons vrc new))))))
  (if new
    (progn
      (foreach vrt (reverse new)
	(setq cor (append cor (mapcar 'cons '(10 40 41 42) vrt))))
      (entmod cor)))
  (princ)
  )

Here's what (- rad r) represents. 

[Sea-Haven]

Eak0s1 if you look at your sample dwg want a simple wave between 2 points, so the insulation.lsp examples do just that, they have some simple rules about height of insulation, but you can change it, then a repeating pattern making a pline from scratch with bulges no go back and add fillets. 

Not sure how to make the answer simpler.

(setq p1 (getpoint "\n1st point: "))
	(setq p9 (getpoint P1 "\nend point : "))
	
lots of stuff

; routine to set N as number of pline segments as a factor of 90 mm.
; 90 mm 25 arc's with straights

lots of stuff

(command "pLINE"  p2 "w" 0.0 0.0)

repeat N
work out points

; now put pts 3,4,5,6
		(command "a" "ce" p3 "a" "-180" "l" p5 "a" "ce" p6 p7 "l" p8)
; parallel lines now drawn

another
; arcs only based on 90 mm high INSULATION
another
; lines only based on 90 mm high ACOUSTIC
another
; straight lines SMOKE
another
; arcs only based on 90 mm high INSULATION

[john.uhden]

That's easy to say if there are no compound or reverse curves, but there's a possible way around that too.

[Sea-Haven]

You are correct the example is for a 2 point pick, if want a pline all angles then maybe start looking at Linetypes.

[eakos1]

I'm one step forward. 

Now my program is working fine if I increase the radius which means the length of the polyline will be shorter.

But I wanted to change the with of the changed ARCs but it is not working. And I cannot understand why?

The first two lines are working when I change the points in the polyline but the with is not. Have somebody any idea?

(setq ed (subst (cons 10 p-2_new) (nth (- i 10) ed) ed))
(setq ed (subst (cons 10 p-1_new) (nth (- i 5) ed) ed))
(setq ed (subst (cons 40 w) (nth (- i 9)ed) ed))
(setq ed (subst (cons 41 w) (nth (- i 8)ed) ed))

(defun C:R_change (/	  e	 ed	i      vt     p0     p-1    p-2	   p-3	  r	 r_new	pc_new delta_r
		   min_r  d	 pc	alfa   bulge  bulge0 bulge-1	   bulge-2	 bulge-3       X      Y
		   b1	  b2	 b3	b4     w
		  )

   (vl-load-com)
   (setq e  (car (entsel))
	 ed (entget e)
   )
   (setq i 0)
   (setq delta_r 0.1) ;the value with the radius has to be increased or decreased
   (setq min_r 3)
   (setq w 1.0)	    ;width of the polyline

   (if (= (cdr (assoc 0 ed)) "LWPOLYLINE")
      (repeat (length ed)
	 (if (= (car (nth i ed)) 10) ;if item is a vertex
	    (progn
	       (setq vt (cdr (nth i ed))) ; get vertex values
;;;	       (princ vt)
;;;	       (command "point" vt)
	       (setq p-3 p-2 ;collecting and store the current and three previous points
		     p-2 p-1
		     p-1 p0
		     p0	 vt
	       )
	       (setq bulge (cdr (nth (+ i 3) ed))) ; get vertex values
	       (setq bulge-3 bulge-2 ;collecting and store the current and three previous bulges
		     bulge-2 bulge-1
		     bulge-1 bulge0
		     bulge0  bulge
	       )
	       (if (and (= bulge-1 0) (= bulge-3 0) (/= bulge-2 0)) ;checking if between two lines is an ARC
		  (progn
;;;		     (setq X (car p-2)) ; get the x value
;;;		     (setq Y (cadr p-2)) ; get the y value
;;;		     (setq Y (+ 5 Y)) ; increment the Y value by 5 units
;;;		     (setq vt (subst Y (nth 1 vt) vt))
;;;		     (setq ed (subst (cons 10 vt) (nth i ed) ed))
		    ; replace the old y value with the new y value
		    ; update the entity definition with new vertex information

		     (setq r (LM:BRad p-1 p-2 bulge-2))
		     ----------------------------------------

;;;		    ;if the radius has to be decreased = radius is negative --> length of the polyline increased
;;;		     (If (< delta_r 0)
;;;			(progn
;;;			   (if (< r (+ min_r (abs (delta_r)))) ;check that dont go under the min. radius
;;;			      (setq r min_r)
;;;			      (setq r (- r delta_r))
;;;			   ) ;if
;;;			   (Setq pc (LM:BCen p-1 p-2 bulge-2)) ;center of the ARC
;;;
;;;		    ;check if the lines are tangent to the ARC -> it is a real fillet
;;;			   (if (and (= (rtos (abs (- (angle p-3 p-2) (angle p-2 pc)))) (rtos (/ pi 2)))
;;;				    (= (rtos (abs (- (angle p0 p-1) (angle p-1 pc)))) (rtos (/ pi 2)))
;;;			       ) ;and
;;;			      (setq alfa (- 90 (* 2 (atan bulge-2))))
;;;			      (polar pc alfa)
;;;
;;;			   ) ; if
;;;
;;;			   (setq bulge (+ bulge-2 0.1))
;;;			   (setq ed (subst (cons 42 bulge) (nth (- i 7) ed) ed))
;;;
;;;			) ; progn
;;;		     ) ; if

		     ----------------------------------------

		    ;if the radius has to be increased = radius is positive --> length of the polyline decreased
		     (If (> delta_r 0)
			(progn

			   (setq r_new (+ r delta_r)) ;the new radius
			   (Setq pc (LM:BCen p-2 p-1 bulge-2)) ;center of the current ARC

		    ;check if the lines are tangent to the ARC -> whetherr is a real fillet
			   (if (and (= (rtos (abs (- (angle p-2 pc) (angle p-2 p-3)))) (rtos (/ pi 2)))
				    (= (rtos (abs (- (angle p-1 p0) (angle p-1 pc)))) (rtos (/ pi 2)))
				    (> (distance p-3 p-2) delta_r) ;wheather the line is not too short
				    (> (distance p-1 p0) delta_r) ;wheather the line is not too short
			       ) ; and
			      (progn

				 (setq alfa (- (DtR 90) (abs (* 2 (atan bulge-2)))))
				 (setq c (/ delta_r (sin alfa)))
				 (setq pc_new (polar (polar p-2 (angle p-2 pc) r_new) (angle p-2 p-3) (* c (cos alfa))))
		    ; pc_new = center of the increased ARC
				 (setq p-2_new (polar p-2 (angle p-2 p-3) (* c (cos alfa))))
				 (setq p-1_new (polar p-1 (angle p-1 p0) (* c (cos alfa))))
		    ;				 (setq bulge_new (/ (- (angle pc_new p-1_new) (angle pc_new p-2_new)) 4)) --> not needed
		    ;put the new cordinates into the data of polyline
				 (setq ed (subst (cons 10 p-2_new) (nth (- i 10) ed) ed))
				 (setq ed (subst (cons 10 p-1_new) (nth (- i 5) ed) ed))
				 (setq ed (subst (cons 40 w) (nth (- i 9)ed) ed))
				 (setq ed (subst (cons 41 w) (nth (- i 8)ed) ed))
;;;				 (princ (nth (- i 9)ed))
;;;				 (princ (nth (- i 8)ed))
;;;				 (princ (nth (- i 7)ed))
;;;				 (princ (nth (- i 6)ed))
;;;				 (princ (nth (- i 5)ed))
				       
		    ;				 (setq ed (subst (cons 42 bulge_new) (nth (- i 7) ed) ed)) --> bulge not needs a change
				 (entmod ed) ; update the drawing

			      ) ; progn
			   ) ; if
			) ; progn
		     ) ; if

		     ----------------------------------------
		     (entmod ed) ; update the drawing
		  )
	       )

	    )	    ;progn
	 )	    ;if
	 (setq i (1+ i))
      )		    ;repeat
   )		    ;if

   (princ)
)		    ;end defun

---------------------------------------------------------------------------------
---------------------------------------------------------------------------------

;; Bulge Centre  -  Lee Mac
;; p1 - start vertex
;; p2 - end vertex
;; b  - bulge
;; Returns the centre of the arc described by the given bulge and vertices

(defun LM:BCen (p1 p2 b)
   (polar p1 (+ (angle p1 p2) (- (/ pi 2) (* 2 (atan b)))) (/ (* (distance p1 p2) (1+ (* b b))) 4 b))
)

------------------------------

;; Bulge Radius  -  Lee Mac
;; p1 - start vertex
;; p2 - end vertex
;; b  - bulge
;; Returns the radius of the arc described by the given bulge and vertices
(defun LM:BRad (p1 p2 b)
   (/ (* (distance p1 p2) (1+ (* b b))) 4 (abs b))
)

-----------------------------

;; converts radians to degrees
(defun RtD (r) (* 180.0 (/ r pi)))

;; converts degrees to radians
(defun DtR (d) (* pi (/ d 180.0)))