Hi, I've got some time to look at your code and here below is my result:
It's not complete, but it's a good start.
You've been overly complicating it. You dont need to check if the line is out of the diameter. You need to compute the lenght of the line from the given point to the circle and then round it to match the "Pitch".
PS.: Don't call me "Owner", it's just a nickname. I'm Mike, as it stands in my signature 😉
Sub Main()
Dim oDoc As Document = ThisApplication.ActiveDocument
If TypeOf ThisApplication.ActiveEditObject Is Sketch Then
oSketch = ThisApplication.ActiveEditObject
Else
MsgBox("Run this rule from an open sketch, please.")
Exit Sub
End If
Try
oArea = InputBox("Please enter the diameter to be filled.", "Area input", 1000)
If oArea = 0 Then
Exit Sub
End If
OrigSize = InputBox("Please enter the pitch.", "Pitch input", 25)
If OrigSize = 0 Then
Exit Sub
End If
Catch
Exit Sub
End Try
CreateLines()
oSketch.ExitEdit
InventorVb.DocumentUpdate()
End Sub
Private Amount As Integer
Private oArea As Double
Private oLine As SketchLine
Private OrigSize As Double
Private oSketch As Sketch
Private oRadius As Double
Private angA As Double
Private First As Boolean
Private Sub CreateLines()
Dim PI As Double = 4 * Atan(1)
Dim TG As TransientGeometry = ThisApplication.TransientGeometry
oArea = oArea * 0.1 'cm to mm
oRadius = oArea * 0.5
OrigSize = OrigSize * 0.1 'cm to mm
Dim PosX As Double = -oRadius
Dim PosY As Double = 0
Dim LastPosX As Double = -oRadius
Dim PassSin as Double = (OrigSize * Sin(PI / 3))
Dim PassCos as Double = (OrigSize * Cos(PI / 3))
Dim Amount As Integer = Floor(oArea / (OrigSize * 2)) * 4
Dim Point1 As Point2D = TG.CreatePoint2d(-oRadius, 0)
Dim Point2 As Point2D
Dim Position As Integer = 1
Dim Sin60 As Double = Sin(PI / 3)
Dim Cos60 As Double = Cos(PI / 3)
angA = (PI / 3) * 2
First = True
For i = 1 To Amount
Select Case Position
Case 1
LastPosX = LastPosX + OrigSize
PosX = LastPosX
Point2 = TG.CreatePoint2d(LastPosX, PosY)
Try
oLine = oSketch.SketchLines.AddByTwoPoints(oLine.EndSketchPoint, Point2)
Catch
oLine = oSketch.SketchLines.AddByTwoPoints(Point1, Point2)
End Try
oSketch.GeometricConstraints.AddGround(oLine)
Case 2
Dim oLenght As Double = oLineLenght(LastPosX)
PosX = PosX - (Cos60 * oLenght)
PosY = Sin60 * oLenght
Point2 = TG.CreatePoint2d(PosX, PosY)
AddLine(Point2)
Case 3
PosX = PosX + PassSin
PosY = PosY + PassCos
Point2 = TG.CreatePoint2d(PosX, PosY)
AddLine(Point2)
Case 4
LastPosX = LastPosX + OrigSize
PosY = 0
Point2 = TG.CreatePoint2d(LastPosX, PosY)
AddLine(Point2)
End Select
If Position = 4 Then Position = 1 Else Position = Position + 1
Next
End Sub
Private Sub AddLine(PointB As Point2D)
oLine = oSketch.SketchLines.AddByTwoPoints(oLine.EndSketchPoint, PointB)
oSketch.GeometricConstraints.AddGround(oLine)
End Sub
Private Function oLineLenght(Distance As Double) As Double
Dim angB As Double = ASin(-Distance / (oRadius / Sin(angA)))
Dim angC As Double = (PI - angA) - angB
Dim maxLenght As Double = (oRadius / Sin(angA)) * Sin(angC)
Dim oLineAmount As Double = Floor(maxLenght / OrigSize)
If Distance > 0 Then
oLineAmount = oLineAmount - 1
If First Then
oLineAmount = oLineAmount + 1
First = False
End If
If Distance >= (oRadius - (OrigSize * 3)) And Distance < (oRadius - (OrigSize * 2)) Then
oLineAmount = oLineAmount - 1
End If
End If
oLineLenght = oLineAmount * OrigSize
End Function
Consider using "Accept as Solution" / "Kudos" if you find this helpful.
- - - - - - - - - - - - - - -
Regards,
Mike
"Always code as if the guy who ends up maintaining your code will be a violent psychopath who knows where you live." - John F. Woods
