topic Drawing Polygons: Octagon, Hexagon, etc in VBA Forum

Drawing Polygons: Octagon, Hexagon, etc

Anonymous — Wed, 07 Feb 2007 19:38:45 GMT

So I need to write a code that can draw an octagon and/or hexagon .. I'd imagine getting the code right for one would be able to be manipulated to draw the other

Researching through these boards, I found this bit of code from Josh ... but I'm having unfortunate results ... is this still the best accepted way of drawing a polygon? Please advise!

User will give the width (height = width), I can specify the number of legs ... just unsure of which route to go or how to go about tackling this monster!

Thank you much!
Ryne

... here is josh's suggestion for drawing polygons that hasn't worked, if this is still the best way of drawing a polygon, let me know and i will try further to manipulate this code for my use - thanks!!!

Here's a snip of how to use it:

Set Hex = Blk.AddLightWeightPolyline(CalculatePolygon(InstPt, 6, 1,
HexDia / 2, 90))

And the function is below. Watch for wordwrap.
-Josh

'creates the verteces list (an array of doubles representing two-element
points) for a defined polygon
'provides the ability to create the polygon in a block or paperspace as
well as modelspace
Function CalculatePolygon(Inst As Variant, Num As Integer, Circ As
Integer, Rad As Double, Optional Ang As Double) As Variant
'where Inst is the insertion point,
'Num is the number of sides,
'Circ defines whether the polygon is inscribed or circumscribed
'Rad is the Radius of the circle,
'and Ang is the optional rotation angle, default will be 0#
Dim PP As Variant, I As Integer
Dim PP2 As Variant, Vertece As Variant
Dim Lin As AcadLine
Dim Base As Double, Hypotenuse As Double
Dim VerteceCount As Integer
VerteceCount = Num * 2 - 1
Dim Vray() As Double
ReDim Vray(0 To VerteceCount) As Double
Dim Degs As Double, ConAng As Double
Degs = 360 / Num
Dim Poly As AcadLWPolyline
PP = ThisDrawing.Utility.PolarPoint(Inst, Radians(Ang), Rad)
If Circ = acInscribed Then
Vray(0) = PP(0): Vray(1) = PP(1)
For I = 1 To (Num - 1)
Ang = Ang + Degs
Vertece = ThisDrawing.Utility.PolarPoint(Inst, Radians(Ang), Rad)
Vray(I * 2) = Vertece(0): Vray(I * 2 + 1) = Vertece(1)
Next I
ElseIf Circ = acCircumscribed Then
ConAng = 360 / (Num * 2)
For I = 1 To Num
Ang = Ang + Degs
PP2 = ThisDrawing.Utility.PolarPoint(Inst, Radians(Ang), Rad)
Set Lin = ThisDrawing.ModelSpace.AddLine(PP2, PP)
Base = Lin.Length / 2
Hypotenuse = Base / Cos(Radians(ConAng))
Vertece = ThisDrawing.Utility.PolarPoint(PP2, Radians(ConAng) +
Lin.Angle, Hypotenuse)
Lin.Delete
Vray((I * 2) - 2) = Vertece(0): Vray((I * 2) - 1) = Vertece(1)
PP(0) = PP2(0): PP(1) = PP2(1)
Next I
End If
CalculatePolygon = Vray
End Function

Re: Drawing Polygons: Octagon, Hexagon, etc

Anonymous — Wed, 07 Feb 2007 23:03:10 GMT

Hi Ryne
Give this a try

Option Explicit
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
Function PolygonVexs(cenPt As Variant, iNum As Integer, _
dblRad As Double, Optional mode As Integer = 0) As Variant
Dim tmpPt As Variant
Dim iCnt As Integer
Dim vCnt As Integer
Dim vxCnt As Integer
Dim PI As Double
PI = Atn(1) * 4
Dim dltAng As Double
Dim dblAng As Double

dltAng = 2 * PI / iNum
vxCnt = 2 * iNum - 1
iCnt = 0
vCnt = 0
ReDim ptsarr(0 To vxCnt) As Double
If mode = 0 Then dblRad = dblRad / Cos(dltAng / 2)
While iCnt < iNum
dblAng = dltAng * iCnt
tmpPt = ThisDrawing.Utility.PolarPoint(cenPt, dblAng, dblRad)
iCnt = iCnt + 1
ptsarr(vCnt) = tmpPt(0): ptsarr(vCnt + 1) = tmpPt(1)
vCnt = vCnt + 2
Wend
PolygonVexs = ptsarr
End Function

'~~~~~~~~~~~~~~~~~~~~~'
Sub drawPolygon()
Dim oPline As AcadLWPolyline
Dim cenPt(2) As Double
Dim iNum As Integer
Dim dblAng As Double
Dim dblRad As Double
iNum = 8
dblRad = 10#
cenPt(0) = 0: cenPt(1) = 0: cenPt(2) = 0
' draw Inscribed polygon:
Set oPline = ThisDrawing.ModelSpace.AddLightWeightPolyline _
(PolygonVexs(cenPt, 8, 10#, 1))
' draw Circumscribed polygon:
'Set oPline = ThisDrawing.ModelSpace.AddLightWeightPolyline _
'(PolygonVexs(cenPt, 8, 10#, 0))
'or the same
'Set oPline = ThisDrawing.ModelSpace.AddLightWeightPolyline _
'(PolygonVexs(cenPt, 8, 10#))'<-- optional mode omitted
oPline.Closed = True
oPline.Update
End Sub
'~~~~~~~~~~~~~~~~~~~~~~'

~'J'~

Re: Drawing Polygons: Octagon, Hexagon, etc

Anonymous — Thu, 08 Feb 2007 15:35:55 GMT

wow that's amazing - really really really thank you!

i need to manipulate a few things, so i would be able to set the actual width of the polygon, etc

im going to play with the code a little, i may post a question or two here later - but i wanted to post a prompt thank you first

Re: Drawing Polygons: Octagon, Hexagon, etc

Anonymous — Thu, 08 Feb 2007 15:43:49 GMT

Sorry, Ryne
I do not understood your question,
my english level not so good as your...
Explain me little more or upload some
picture (bmp or dwg) with explanations

Thanks

~'J'~

Re: Drawing Polygons: Octagon, Hexagon, etc

Anonymous — Thu, 08 Feb 2007 15:59:32 GMT

does this help you??

Re: Drawing Polygons: Octagon, Hexagon, etc

Anonymous — Thu, 08 Feb 2007 16:36:08 GMT

I see it,
I'll add some lines to the code by
your needs

Later,

~'J'~

Re: Drawing Polygons: Octagon, Hexagon, etc

Anonymous — Thu, 08 Feb 2007 17:19:00 GMT

Give it a whirl,
hope it will works as you want

Option Explicit
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
Function PolygonVexs(cenPt As Variant, iNum As Integer, _
dblRad As Double, Optional mode As Integer = 0) As Variant

Dim tmpPt As Variant
Dim iCnt As Integer
Dim vCnt As Integer
Dim vxCnt As Integer
Dim PI As Double
PI = Atn(1) * 4
Dim dltAng As Double
Dim dblAng As Double
Dim initAng As Double

dltAng = 2 * PI / iNum
initAng = dltAng / 2
vxCnt = 2 * iNum - 1
iCnt = 0
vCnt = 0
ReDim ptsarr(0 To vxCnt) As Double
If mode = 0 Then dblRad = dblRad / Cos(dltAng / 2)
While iCnt < iNum
dblAng = initAng + dltAng * iCnt
tmpPt = ThisDrawing.Utility.PolarPoint(cenPt, dblAng, dblRad)
iCnt = iCnt + 1
ptsarr(vCnt) = tmpPt(0): ptsarr(vCnt + 1) = tmpPt(1)
vCnt = vCnt + 2
Wend

PolygonVexs = ptsarr
End Function
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
Sub drawPolygon()

Dim oPline As AcadLWPolyline
Dim cenPt As Variant
Dim iNum As Integer
Dim dblAng As Double
Dim dblRad As Double
cenPt = ThisDrawing.Utility.GetPoint(, vbCr & "Pick center point of polygon")
iNum = CInt(InputBox(vbNewLine & "Enter number of polygon sides:", _
"Parameter Input", 8))
dblRad = CDbl(InputBox(vbNewLine & "Enter the actual size of polygon:", _
"Parameter Input", 20)) / 2
' draw Circumscribed polygon:
Set oPline = ThisDrawing.ModelSpace.AddLightWeightPolyline _
(PolygonVexs(cenPt, iNum, dblRad))
oPline.ConstantWidth = 0.25
oPline.Layer = "0"
oPline.color = acYellow
oPline.Closed = True
oPline.Update

End Sub

~'J'~

Re: Drawing Polygons: Octagon, Hexagon, etc

Anonymous — Thu, 08 Feb 2007 17:29:44 GMT

YOU
ARE
AMAZING!!

Re: Drawing Polygons: Octagon, Hexagon, etc

Anonymous — Thu, 08 Feb 2007 17:31:02 GMT

still on point for hexagon?

I can have two functions, one for hexagon (6), one for octagon(8) as long as I can declare the actual size

Can you add in "actual size" to old code?

Re: Drawing Polygons: Octagon, Hexagon, etc

Anonymous — Thu, 08 Feb 2007 18:19:59 GMT

Ryne,
Start from this sample, then
change TextBox1 on ComboBox2
and fill it with desired actual sizes
as I did it with ComboBox1, see code
Hth

~'J'~