[Keith Vetter] 2003-03-19 : for another project I needed to draw polygons but with rounded corners. The page [Drawing rounded rectangles] provided the approach I needed, so I generalized it
to work for any polygon and with arbitrary radii for each vertex.

The code works equally well for concave as well as convex polygons.

There is some demonstration code to show its capabilities on regular
polygons (using code from [Regular polygons]) and on a 
star shape ([Sun, moon, and stars]).

------

[uniquename] 2013aug18

For readers who do not have the time/facilities/whatever to setup and run the code below,
here is an image that shows how this code draws the rounded corners for a given polygon.
And you can see the choices of polygons according to the radiobuttons at the bottom of
the GUI.

[vetter_Drawing-rounded-polygons_wiki8590_screenshot_508x547.jpg]

------
----
[Jeff Smith] 2019-08-26 : Below is an online demo using [CloudTk]

<<inlinehtml>>

<iframe height="550" width="550" src="https://cloudtk.tcl-lang.org/cloudtk/VNC?session=new&Tk=Drawing-rounded-polygons" allowfullscreen></iframe>

<<inlinehtml>>

----
======
 #----------------------------------------------------------------------
 #
 # RoundPoly -- Draw a polygon with rounded corners in the canvas, based
 # off of ideas and code from "Drawing rounded rectangles"
 #
 # Parameters:
 #       w - Path name of the canvas
 #       xy - list of coordinates of the vertices of the polygon
 #       radii - list of radius of the bend each each vertex
 #       args - Other args suitable to a 'polygon' item on the canvas
 #
 # Results:
 #       Returns the canvas item number of the rounded polygon.
 #
 # Side effects:
 #       Creates a rounded polygon in the canvas.
 #
 #----------------------------------------------------------------------
 
 proc RoundPoly {w xy radii args} {
    set lenXY [llength $xy]
    set lenR [llength $radii]
    if {$lenXY != 2 * $lenR} {
        error "wrong number of vertices and radii"
    }
 
    # Walk down vertices keeping previous, current and next
    foreach {x0 y0} [lrange $xy end-1 end] break
    foreach {x1 y1} $xy break
    eval lappend xy [lrange $xy 0 1]
    set knots {}                                ;# These are the control points
 
    for {set i 0} {$i < $lenXY} {incr i 2} {
        set radius [lindex $radii [expr {$i/2}]]
        set r [winfo pixels $w $radius]
 
        foreach {x2 y2} [lrange $xy [expr {$i + 2}] [expr {$i + 3}]] break
        set z [_RoundPoly2 $x0 $y0 $x1 $y1 $x2 $y2 $r]
        eval lappend knots $z
 
        foreach {x0 y0} [list $x1 $y1] break    ;# Current becomes previous
        foreach {x1 y1} [list $x2 $y2] break    ;# Next becomes current
    }
    set n [eval $w create polygon $knots -smooth 1 $args]
    return $n
 }
 proc _RoundPoly2 {x0 y0 x1 y1 x2 y2 radius} {
    set d [expr { 2 * $radius }]
    set maxr 0.75
 
    set v1x [expr {$x0 - $x1}]
    set v1y [expr {$y0 - $y1}]
    set v2x [expr {$x2 - $x1}]
    set v2y [expr {$y2 - $y1}]
 
    set vlen1 [expr {sqrt($v1x*$v1x + $v1y*$v1y)}]
    set vlen2 [expr {sqrt($v2x*$v2x + $v2y*$v2y)}]
    if {$d > $maxr * $vlen1} {
        set d [expr {$maxr * $vlen1}]
    }
    if {$d > $maxr * $vlen2} {
        set d [expr {$maxr * $vlen2}]
    }
 
    lappend xy [expr {$x1 + $d * $v1x/$vlen1}] [expr {$y1 + $d * $v1y/$vlen1}]
    lappend xy $x1 $y1
    lappend xy [expr {$x1 + $d * $v2x/$vlen2}] [expr {$y1 + $d * $v2y/$vlen2}]
 
    return $xy
 }
 ################################################################
 #
 # Demonstration code
 
 # Code from Regular polygons
 proc rp {x0 y0 x1 y1 {n 0}} {
    set xm [expr {($x0+$x1)/2.}]
    set ym [expr {($y0+$y1)/2.}]
    set rx [expr {$xm-$x0}]
    set ry [expr {$ym-$y0}]
    if {$n==0} {
        set n [expr {round(($rx+$ry)*0.5)}]
    }
    set step [expr {atan(1)*8/$n}]
    set res ""
    set th [expr {atan(1)*6}] ;#top
    for {set i 0} {$i<$n} {incr i} {
        lappend res \
            [expr {$xm+$rx*cos($th)}] \
            [expr {$ym+$ry*sin($th)}]
        set th [expr {$th+$step}]
    }
    set res
 }
 
 # Code from Sun, moon, and stars
 proc MakeStar {x y delta} {
    set pi [expr {atan(1) * 4}]
 
    # Compute distance to inner corner
    #set x1 [expr {cos(54 * $pi/180)}]          ;# Unit vector to inner point
    set y1 [expr {sin(54 * $pi/180)}]
    set y2 [expr {$delta * sin(18 * $pi/180)}]  ;# Y value to match
    set delta2 [expr {$y2 / $y1}]
 
    # Now get all coordinates of the 5 outer and 5 inner points
    for {set i 0} {$i < 10} {incr i} {
        set d [expr {($i % 2) == 0 ? $delta : $delta2}]
        set theta [expr {(90 + 36 * $i) * $pi / 180}]
        set x1 [expr {$x + $d * cos($theta)}]
        set y1 [expr {$y - $d * sin($theta)}]
 
        lappend coords $x1 $y1
    }
    return $coords
 }
 proc doit { args } {
    global rad nsides
 
    # Get canvas dimensions shrunk by some
    foreach who {x0 y0 x1 y1} val [.c cget -scrollregion] d {30 30 -30 -30} {
        set $who [expr {$val + $d}]
    }
 
    if {$nsides == -1} {                        ;# Star
        set xy [MakeStar 0 0 [expr {$x1 > $y1 ? $y1 : $x1}]]
    } elseif {$nsides == 4} {                   ;# Want square not diamond
        set xy [list $x0 $y0 $x1 $y0 $x1 $y1 $x0 $y1]
    } elseif {$nsides == -4} {                  ;# Rectangle
        set y0 [expr {$y0 / 2}]
        set y1 [expr {$y1 / 2}]
        set xy [list $x0 $y0 $x1 $y0 $x1 $y1 $x0 $y1]
    } else {                                    ;# Regular polygon
        set xy [rp $x0 $y0 $x1 $y1 $nsides]
    }
    set radii {}
    foreach {x y} $xy {
        lappend radii $rad([expr {[llength $radii] & 1}])
    }
 
    .c delete poly
    .c create poly $xy -fill gray90 -outline black -dash . -tags poly
    RoundPoly .c $xy $radii -fill white -outline black -tags poly
    .c create poly $xy -fill {} -outline black -dash . -tags poly
 }
 proc Recenter {W h w} {
    set h [expr {$h / 2.0}] ; set w [expr {$w / 2.0}]
    $W config -scrollregion [list -$w -$h $w $h]
    doit
 }
 
 
 canvas .c -width 500 -height 500 -bd 2 -relief raised
 frame .shapes -bd 2 -relief ridge
 scale .rad1 -orient horizontal -label "Odd Vertex Radius" -variable rad(0) \
    -from 0 -to 200 -command doit -relief ridge
 scale .rad2 -orient horizontal -label "Even Vertex Radius" -variable rad(1) \
    -from 0 -to 200 -command doit -relief ridge
 image create photo ::img::blank -width 1 -height 1
 button .about -image ::img::blank -highlightthickness 0 -command \
    {tk_messageBox -message "Rounded Polygon\nby Keith Vetter, March 2003"}
 place .about -in .shapes -relx 1 -rely 1 -anchor se
 
 set row [set col 0]
 foreach {name sides} {Triangle 3 Square 4 Rectangle -4 Pentagon 5 Hexagon 6
    Heptagon 7 Octagon 8 Enneagon 9 Decagon 10 Star -1} {
    radiobutton .shapes.p$name -text $name -variable nsides \
        -command doit -value $sides -anchor w
    grid .shapes.p$name -row $row -column $col -sticky ew
    if {[incr col] == 5} {incr row ; set col 0}
 }
 grid .c - -row 0 -sticky news
 grid .shapes - -sticky ew
 grid .rad1 .rad2 -sticky ew
 grid rowconfigure . 0 -weight 1
 grid columnconfigure . {0 1} -weight 1
 grid columnconfigure .shapes 100 -weight 1
 bind .c <Configure> {Recenter %W %h %w}
 
 set nsides 4
 set rad(0) 150
 set rad(1) 50
======

----
**See Also**

   * [Round Polygons]

<<categories>> Polygon | Graphics