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)
)

[ВeekeeCZ]

---

@ВeekeeCZ wrote:

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.

---

This code should do the job the way described above.

;; it changes all arches of rad greater than given limit (mxm) to specified radius (rad+) if rad+ only if rad+ is lower than the current one.
;; it does not check whether current arc segments are tangent or not. (presumably they are)
;; width of changed arches change to specified vaule or keeped current if nil

(defun c:Prad (/ CAB:group_on LM:BCen LM:BRad :tan
	       e rad+ d mxm vrs cor nxt l21 vrc vrd c10 c10+ c40 c41 c42 d10 d10 d10+ d41 d42 new alf)   ; c10 current vertex, d10 next to current, c10+ newly calculated c10, d10+ new for d10
  
  ;;  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)))

  (defun :tan (x /) (/ (sin x) (cos x)))
  
  ; -------------------------------------------------------------------------------------------------------------------------------

  (setq rad+ 3)  ; new radius
  (setq mxm 4)   ; limit rad
  (setq wid 2.)  ; nil to keep current
  
  (if (and (setq e (car (entsel "Select pl: ")))
	   (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 43 91))) d))
	   )
    
    (while (setq vrc (car vrs))
      
      (mapcar 'set '(c10 c40 c41 c42) vrc)

      (cond ((= c42 0) 			; currect seg is line
	     (setq new (cons vrc new) 		; add it to new
		   vrs (cdr vrs)))		; remove 1 from old
	    (t		; current seg is arc
	     (setq vrd (cond ((cadr vrs))	; new vertex
			     ((setq l21 (list (vlax-curve-getendpoint e) 0. 0. 0.))))) ; closed pl with last arc seg; change first vrt with last (* later)
	     (mapcar 'set '(d10 d40 d41 d42) vrd)
	     (setq cen (LM:Bcen c10 d10 c42)
		   rad (LM:Brad c10 d10 c42))
	     (if (or (<= rad mxm) (< rad rad+)) 	; if current rad is already lower than acceptable maximum or lower than new radius
	       (setq new (cons vrc new)			; then keep it
		     vrs (cdr vrs)
		     l21 nil)
	       (progn					; else change the radius
		 (if (not nxt)  			; if no previous straight segment 
		   (setq new (cons (reverse (cons 0. (cdr (reverse vrc)))) new))) ; then create new line-vertex 
		 (setq alf (* 2 (atan c42)))  		; = half or arc angle
		 (setq c10+ (polar c10 (rem (+ (angle cen c10) (* (/ c42 (abs c42)) (/ pi 2)) (* 2 pi)) (* 2 pi)) (abs (- (* rad+ (:tan alf)) (* rad (:tan alf)))))
		       d10+ (polar d10 (rem (+ (angle d10 cen) (* (/ c42 (abs c42)) (/ pi 2)) (* 2 pi)) (* 2 pi)) (abs (- (* rad+ (:tan alf)) (* rad (:tan alf))))))
		 (setq new (cons (list c10+ (cond (wid) (c40)) (cond (wid) (c41)) c42) new)) ; add current seg to new
		 (if (= 0 d42)					; if next segment is straight
		   (setq new (cons (list d10+ d40 d41 0) new)	   ; then add that one to new too
			 vrs (cddr vrs)) 			   ; and remove 2 from the old one
		   (setq new (cons (list d10+ c40 c41 0) new)	   ; else add extra straight seg
			 vrs (cdr vrs)))))))			   ; and remove 1 from old one.
      (setq nxt T)))

  (if new
    (progn
      (setq new (if l21
		  (cons (cons (caar new) (cdar (reverse new))) (cdr (reverse new)))   ; here is * later - replace first segment with last one. Remove last one.
		  (reverse new)))
      (foreach vrt new
	(setq cor (append cor (mapcar 'cons '(10 40 41 42) vrt))))
      (entmod (subst (cons 90 (length new)) (assoc 90 new) cor))))
  (princ)
  )

[eakos1]

Finally I rewrite my program and now it is simpler and also the changing of the with of the changed ARC segment is working. 😀

(defun C:RAD_C (/ e ed i counter n tmp p0 p-1 p-2 p-3 bulge0 bulge-1 bulge-2 bulge-3 r r_new pc	alfa c pc_new p-1_new
		p-2_new)


   (vl-load-com)

   (if (null global:min_r)
      (setq global:min_r 3.0)
   )
   (if (null global:delta_r)
      (setq global:delta_r 0.1)
   )
   (if (null global:width) ;width of the changed ARCs in the polyline
      (setq global:width 1)
   )
   (if (null global:change_width)
      (setq global:change_width "Y")
   )

   (setq tmp (getstring	(strcat	"\nRAD_CHANGE: [W]idth of the changed ARCs:<"
				(rtos global:width)
				"> "
				"[C]hange the width? Yes/No <"
				global:change_width
				"> "
				"[M]inimum radius <"
				(rtos global:min_r)
				"> "
				"[D]elta radius <"
				(rtos global:delta_r)
				"> "
			)
	     )
   )

   (cond
      ((= (strcase tmp) "W")
       (setq global:width (cond	((getreal "\nGive the new width of changed ARCs"))
				(1)
			  )
       )
      )
      ((= (strcase tmp) "M") (setq global:min_r (getreal "\nGive the new minimum radius")))
      ((= (strcase tmp) "D") (setq global:delta_r (getreal "\nGive the new delta radius")))
   )		    ;cond

   (if (= (strcase tmp) "C")
      (progn
	 (initget "Y N")
	 (setq global:change_width
		 (getkword (strcat "\nDo you want to increase the width of the changed ARCs [Y/N]: <"
				   global:change_width
				   ">"
			   )
		 )
	 )
      )		    ;progn
   )		    ;if
   (princ global:change_width)
   -------------------------------------------------------------

   (setq i 0)
   (setq counter 0) ;number of changed ARCs in the polyline
   (setq e  (car (entsel))
	 ed (entget e)
   )
   (setq n (+ (fix (vlax-curve-getEndParam e)) 1))
   (command "pedit" e "w" "0" "")


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

   (if (= (cdr (assoc 0 ed)) "LWPOLYLINE")
      (progn
	 (repeat (- n 3)
	    (setq p-3 (vlax-curve-getpointatparam e (+ i 0)))
	    (setq p-2 (vlax-curve-getpointatparam e (+ i 1)))
	    (setq p-1 (vlax-curve-getpointatparam e (+ i 2)))
	    (setq p0 (vlax-curve-getpointatparam e (+ i 3)))

	    (setq bulge-3 (vla-getbulge (vlax-ename->vla-object e) (+ i 0)))
	    (setq bulge-2 (vla-getbulge (vlax-ename->vla-object e) (+ i 1)))
	    (setq bulge-1 (vla-getbulge (vlax-ename->vla-object e) (+ i 2)))
	    (setq bulge0 (vla-getbulge (vlax-ename->vla-object e) (+ i 3)))



	    (if	(and (= bulge-1 0) (= bulge-3 0) (/= bulge-2 0)) ;checking if between two lines is an ARC
	       (progn
		  (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 (< global:delta_r 0)
		     (progn


			(if (and (<= (rtos r) (rtos (+ global:min_r (abs global:delta_r))) ) (/= (rtos r) (rtos global:min_r)) )
		    ;check that dont go under the min. radius

		    ;			   -------------------------------------------

			   (progn
			      (setq r_new global:min_r) ;set the new radius if radius is small
			      (Setq pc (LM:BCen p-2 p-1 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-2 pc) (angle p-2 p-3)))) (rtos (/ pi 2)))
				       (= (rtos (abs (- (angle p-1 p0) (angle p-1 pc)))) (rtos (/ pi 2)))
				  ) ;and
				 (progn
				    (setq counter (+ 1 counter))
				    (setq alfa (- (DtR 90) (abs (* 2 (atan bulge-2)))))
				    (setq c (/ (- global:min_r r) (sin alfa)))
		    ; the new global:delta_r = global:min_r - r
				    (setq b (* c (cos alfa)))
				    (setq pc_new (polar (polar p-2 (angle p-3 p-2) b) (angle p-2 pc) r_new))
		    ; pc_new = center of the increased ARC
				    (setq p-2_new (polar p-2 (angle p-2 p-3) b)) ;new points
				    (setq p-1_new (polar p-1 (angle p-1 p0) b))
				    (change_vertex e (+ i 1) p-2_new)
				    (change_vertex e (+ i 2) p-1_new)

				    (if	(= global:change_width "Y")
				       (change_width e p-2_new global:width)
				    ) ;if
				 ) ;progn
			      ) ;if
			   ) ;progn
			   );if

;;;			   -------------------------------------------
			   
   			(if (and (> r (+ global:min_r (abs global:delta_r))) (/= (rtos r) (rtos global:min_r)))

			   (progn

			      (setq r_new (- r global:delta_r)) ;set the new radius if radius is normal

			      (Setq pc (LM:BCen p-2 p-1 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-2 pc) (angle p-2 p-3)))) (rtos (/ pi 2)))
				       (= (rtos (abs (- (angle p-1 p0) (angle p-1 pc)))) (rtos (/ pi 2)))
				  ) ;and
				 (progn

				    (setq counter (+ 1 counter))
				    (setq alfa (- (DtR 90) (abs (* 2 (atan bulge-2)))))
				    (setq c (/ global:delta_r (sin alfa)))
				    (setq b (* c (cos alfa)))
				    (setq pc_new (polar (polar p-2 (angle p-3 p-2) b) (angle p-2 pc) r_new))
		    ; pc_new = center of the increased ARC
				    (setq p-2_new (polar p-2 (angle p-2 p-3) b)) ;new points
				    (setq p-1_new (polar p-1 (angle p-1 p0) b))
				    (change_vertex e (+ i 1) p-2_new)
				    (change_vertex e (+ i 2) p-1_new)

				    (if	(= global:change_width "Y")
				       (change_width e p-2_new global:width)
				    ) ;if

				 ) ; progn
			      ) ; if

			   ) ;progn if false
			) ;if

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

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

;;;if the radius has to be increased = radius is positive --> length of the polyline decreased

		  (If (> global:delta_r 0)
		     (progn
			(setq r_new (+ r global:delta_r)) ;the new radius
			(Setq pc (LM:BCen p-2 p-1 bulge-2)) ;center of the current ARC
			(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) (* 2 global:delta_r)) ;wheather the line is not too short
				 (> (distance p-1 p0) (* 2 global:delta_r)) ;wheather the line is not too short
			    ) ; and
			   (progn

			      (setq counter (+ 1 counter))
			      (setq alfa (- (DtR 90) (abs (* 2 (atan bulge-2)))))
			      (setq c (/ global: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))))
			      (change_vertex e (+ i 1) p-2_new)
			      (change_vertex e (+ i 2) p-1_new)

			      (if (= global:change_width "Y")
				 (change_width e p-2_new global:width)
			      ) ;if

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

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



	       )    ;progn
	    )	    ;if

	    (setq i (1+ i))

	 )	    ;repeat
      )		    ;progn
   )		    ;if

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

   (princ
      (strcat "\nThe number of ARCs which have been modified in the polyline: " (itoa counter) " pcs")
   )
   (princ)
;;;      (command "regen")

)		    ;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)))

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

;;; Change the width of a given segment in the polyline - Ákos Erdélyi
;;; poly_name - entity name of LWPOLYLINE
;;; point     - the begining point of line which has to be make bold
;;; w         - width which will set up in polyline
(defun change_width (poly_name point w / number_of_vertex)
   (setq number_of_vertex (vlax-curve-getParamAtPoint e point))
   (vla-setwidth (vlax-ename->vla-object e) number_of_vertex w w)
)		    ;defun

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

;;; Change move one vertex in the polyline in a new position - Ákos Erdélyi
;;; poly_name        - entity name of LWPOLYLINE
;;; number_of_vertex - from the begginning which vertex has to be repositioned
;;; 3dp_new          - the new 3d point
(defun change_vertex (poly_name number_of_vertex 3dp_new / 2dp_new)
   (setq 2dp_new (list (car 3dp_new) (cadr 3dp_new)))
   (vla-put-coordinate
      (vlax-ename->vla-object poly_name)
      number_of_vertex
      (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble '(0 . 1)) 2dp_new)
   )

)		    ;degun

[Sea-Haven]

Just a comment this  wave is 29 lines of code with straights connecting arcs just pick start and end points thats all its a pline.

[eakos1]

Just one question. If I put a regen command to the end of the code and if I have a dimension radius on the arc on my wave form polyline which is associative - this is not changing. But why ???

If I don't have regen than if the program ended the associative dimension changed correctly. 

[john.uhden]

Maybe you don't need a regen but just a vla-update on the polyline object.

[eakos1]

It is not for the polyline. I put associative text -  field expression - to each polyline which I want to modify which shows the length of the lines.  But if the program is ended these fields are not refreshing, not showing the new modifed length of the plylines. So I nedd to run the regen. I wantid to put this in my program to save this time to run regen manually.