Drawn Hexagonal rotation

user20 161 Reputation points
2022-06-08T07:47:56.203+00:00

I have code that I can draw a line that ends in a hexagon.
As shown below
209396-222.gif

CODES:

Imports System.Drawing.Drawing2D  
  
Public Class Form4  
       Dim p As Pen = New Pen(Color.Black)  
    Private NewSegment As Segment1  
    Private Segments As New List(Of Segment1)  
  
    Private Sub PictureBox1_MouseDown(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseDown  
              NewSegment = New Segment1(e.Location, e.Location)  
        Segments.Add(NewSegment)  
        PictureBox1.Invalidate()  
    End Sub  
  
    Private Sub PictureBox1_MouseMove(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseMove  
  
        If NewSegment Is Nothing Then Return  
        NewSegment.Point2 = e.Location  
        PictureBox1.Invalidate()  
    End Sub  
  
    Private Sub PictureBox1_Paint(sender As Object, e As PaintEventArgs) Handles PictureBox1.Paint  
  
        e.Graphics.SmoothingMode = Drawing2D.SmoothingMode.AntiAlias  
        For Each segment As Segment1 In Segments  
            segment.Draw(e.Graphics)  
        Next  
    End Sub  
  
    Private Sub PictureBox1_MouseUp(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseUp  
  
        NewSegment = Nothing  
    End Sub  
  
    Private Sub PictureBox1_SizeChanged(sender As Object, e As EventArgs) Handles PictureBox1.SizeChanged  
        PictureBox1.Invalidate()  
    End Sub  
  
 End Class  
  
Class Segment1  
  
    Private pt1, pt2 As Point  
    Private angle As Double = 0  
    Private length As Double = 0  
  
    Private Shared SF As StringFormat  
    Private Const RADIUS As Integer = 20  
    Private Shared drawString As String = "TXT"  
    Private Shared pen1 As New Pen(Color.Black, 1.5)  
    Private Shared drawFontF As New Font("times New roman", 10)  
    Private Shared rc As New Rectangle(New Point(-RADIUS, -RADIUS), New Size(RADIUS * 2, RADIUS * 2))  
  
       Dim p As Pen = New Pen(Color.Black)  
   
    Public Sub New(startPoint As Point, endPoint As Point)  
            Point1 = startPoint  
        Point2 = endPoint  
  
    End Sub  
  
    Public Property Point1 As Point  
        Get  
            Return pt1  
        End Get  
        Set(value As Point)  
            pt1 = value  
            UpdateAngleAndLength()  
        End Set  
    End Property  
  
    Public Property Point2 As Point  
        Get  
            Return pt2  
        End Get  
        Set(value As Point)  
            pt2 = value  
            UpdateAngleAndLength()  
        End Set  
    End Property  
  
    Private Sub UpdateAngleAndLength()  
        angle = Math.Atan2(Point2.Y - Point1.Y, Point2.X - Point1.X) * 180.0 / Math.PI  
        length = Math.Sqrt(Math.Pow(Point2.X - Point1.X, 2) + Math.Pow(Point2.Y - Point1.Y, 2))  
    End Sub  
  
    Public Sub Draw(gr As Graphics)  
               ' save the current state of the graphics  
        Dim curState As GraphicsState = gr.Save()  
  
        ' move the origin to the start point of the line  
        gr.TranslateTransform(Point1.X, Point1.Y)  
        ' rotate the whole surface  
        gr.RotateTransform(angle)  
  
        ' draw the line on the x-axis  
        gr.DrawLine(pen1, 0, 0, CInt(length), 0)  
  
        gr.TranslateTransform((-RADIUS * 2), 0)  
  
             gr.DrawPath(pen1, GetHex(0, 0))  
  
  
            gr.TranslateTransform((RADIUS * 2), 0) ' midway between center and opposite side of circle  
  
        ' orient back to the "normal" so the 90 is upright  
        gr.RotateTransform(-angle)  
        ' draw the 90  
        gr.DrawString(drawString, drawFontF, Brushes.Black, rc, SF)  
  
        ' put the graphics back to the way it was originally  
        gr.Restore(curState)  
    End Sub  
  
    Private m_selected As Boolean  
    Public Property Selected As Boolean  
        Get  
            Return m_selected  
        End Get  
        Set(value As Boolean)  
            m_selected = value  
        End Set  
    End Property  
  
     
       Function GetHex(x As Integer, y As Integer) As GraphicsPath  
        Dim g As New GraphicsPath  
  
        Dim dr As Double = Math.PI / 180  
        Dim xo As Single = Convert.ToSingle(Math.Sin(30 * dr) * RADIUS)  
        Dim xl As Single = Convert.ToSingle(Math.Cos(30 * dr) * RADIUS)  
  
        Dim p(5) As PointF  
        p(0) = New PointF(x + RADIUS, y)  
        p(0) = New PointF(x + RADIUS + xl, y + xo)  
        p(1) = New PointF(x + RADIUS + xl, y + xo + RADIUS)  
        p(2) = New PointF(x + RADIUS, y + xo + xo + RADIUS)  
        p(3) = New PointF(x + RADIUS - xl, y + xo + RADIUS)  
        p(4) = New PointF(x + RADIUS - xl, y - xo + RADIUS)  
        p(5) = New PointF(x + RADIUS, y)  
        g.AddPolygon(p)  
        Return g  
    End Function  
  
End Class  

Now my problem is that I can not change the angle of the hexagon so that when I move the line it looks like the image below
209300-466.jpg

Developer technologies VB
{count} votes

Accepted answer
  1. Jiachen Li-MSFT 34,221 Reputation points Microsoft External Staff
    2022-06-13T06:25:25.603+00:00

    Hi @user20 ,
    I modified the location of the hexagon generation based on your code.
    Try the code below.

        Function GetHex(x As Integer, y As Integer) As GraphicsPath  
            Dim g As New GraphicsPath  
      
            Dim dr As Double = Math.PI / 180  
            Dim xo As Single = Convert.ToSingle(Math.Sin(30 * dr) * RADIUS)  
            Dim xl As Single = Convert.ToSingle(Math.Cos(30 * dr) * RADIUS)  
      
            Dim p(5) As PointF  
            p(0) = New PointF(x + RADIUS + xo, y + xl)  
            p(1) = New PointF(x + 2 * RADIUS + xo, y + xl)  
            p(2) = New PointF(x + 3 * RADIUS, y)  
            p(3) = New PointF(x + 2 * RADIUS + xo, y - xl)  
            p(4) = New PointF(x + RADIUS + xo, y - xl)  
            p(5) = New PointF(x + RADIUS, y)  
            g.AddPolygon(p)  
            Return g  
        End Function  
    

    Here is my resoult.

    210659-image.png
    Best Regards.
    Jiachen Li

    ----------

    If the answer is helpful, please click "Accept Answer" and upvote it.
    Note: Please follow the steps in our documentation to enable e-mail notifications if you want to receive the related email notification for this thread.

    0 comments No comments

0 additional answers

Sort by: Most helpful

Your answer

Answers can be marked as Accepted Answers by the question author, which helps users to know the answer solved the author's problem.