AddReference "System.Drawing"
AddReference "Microsoft.Office.Interop.Excel"
Option Explicit On
Option Infer Off
Imports System.Drawing
Imports System.Windows.Forms
Imports System.ComponentModel
Imports Microsoft.Office.Interop.Excel
Imports System.Runtime.InteropServices
Sub Main()
If Not DocumentTypeValidation(ThisApplication) Then
Exit Sub ' Exit the main subroutine if validation fails
End If
Dim oThisSession As Inventor.Application = ThisApplication
Dim oPartCompDef = oThisSession.ActiveDocument.ComponentDefinition
Dim rectangles As New List(Of Tuple(Of Double, Double))
Dim RectNo As Byte = 1
Dim length As Double = 0.0
Dim yprevOffset As Double = 0.0
Dim xLength As Double = 0.0
Dim yprevHeight As Double = 0.0
Dim RectIndex As Byte = 1
Dim isdone As Boolean = False
Do
Dim InputTuple As Tuple(Of Double, Double) = GetRectangleDimensions(RectNo, isdone)
If InputTuple Is Nothing Then
Exit Do
End If
If RectNo = 1 Then
xLength = InputTuple.Item1
End If
rectangles.Add(InputTuple) ' Add the dimensions to the list
RectNo += 1
Loop
ShowList(rectangles)
Dim SketchforCore As PlanarSketch = oPartCompDef.Sketches.Add(oPartCompDef.WorkPlanes.Item(3))'Create sketch after getting rect values
Dim oOriginPoint As SketchPoint = CheckOriginSketchPoint(oPartCompDef, SketchforCore)
Dim prevRectangleLines As SketchEntitiesEnumerator = Nothing ' To store the lines of the previous rectangle
Dim prevMidOfThirdLine As SketchPoint = Nothing ' To store the midpoint of the third line of the previous rectangle
Dim symmetryLine As SketchLine = CheckYSketchAxis(oPartCompDef, SketchforCore)
symmetryLine.Construction = True
For Each rect As Tuple(Of Double, Double) In rectangles
Dim currentRectangleLines = DrawRectangle(SketchforCore,rect.Item1, rect.Item2) ' Draw the rectangle using the dimensions
ApplyDimsofRectangles(SketchforCore, currentRectangleLines)
Dim currentMidOfFirstLine = GetMidpointOfLinesMiddlePoint(SketchforCore, currentRectangleLines)
Dim currentMidOfThirdLine = GetRectThirdlineMidPoint(SketchforCore, currentRectangleLines)
If RectIndex = 1 Then
CoincidentConstraint(currentMidOfFirstLine, oOriginPoint, SketchforCore) ' First rectangle: Constrain its first line midpoint to the origin
Else
CoincidentConstraint(currentMidOfFirstLine, prevMidOfThirdLine, SketchforCore) ' Constrain the first line midpoint of the current rectangle to the third line midpoint of the previous rectangle
End If
If RectIndex < rectangles.Count Then
Dim symmetryRect = SketchforCore.SketchLines.AddAsTwoPointRectangle(ThisApplication.TransientGeometry.CreatePoint2d(0, 0), ThisApplication.TransientGeometry.CreatePoint2d(1, 1))
AddSymmetryForRectangle(SketchforCore, currentRectangleLines, symmetryRect, symmetryLine) ' Apply symmetry constraints to the rectangle
End If
prevMidOfThirdLine = currentMidOfThirdLine
RectIndex += 1
Next
ThisApplication.ActiveView.GoHome()
ThisApplication.ActiveDocument.save()
End Sub
Function ApplyDimsofRectangles(sketchtoApplyDims As PlanarSketch, rectangleLines As SketchEntitiesEnumerator ) As SketchPoint
Dim doc As PartDocument = ThisApplication.ActiveDocument
Dim compDef As PartComponentDefinition = doc.ComponentDefinition
Dim params As Inventor.Parameters = compDef.Parameters
Dim horDimName As String = "Length_"
Dim verDimName As String = "Width_"
Dim oLine3 = rectangleLines(3) ' Extract the lines for dimensioning
Dim oLine2 = rectangleLines(2) ' Extract the lines for dimensioning
Dim oLengthDimPositionHorizontal = ThisApplication.TransientGeometry.CreatePoint2d(0, 0) ' Create Point2d for dimension text locations
Dim oWidthDimPositionVertical = ThisApplication.TransientGeometry.CreatePoint2d(0, 0) ' Create Point2d for dimension text locations
Dim indexHor As Byte = 1
Dim indexVer As Byte = 1
Try ' Add horizontal dimension constraint
Dim horizontalDim As DimensionConstraint
horizontalDim = sketchtoApplyDims.DimensionConstraints.AddTwoPointDistance(oLine2.StartSketchPoint, oLine2.EndSketchPoint, DimensionOrientationEnum.kVerticalDim, oWidthDimPositionVertical)
Dim newNameHor As String = horDimName & indexHor.ToString()
Dim HorNameExists As Boolean = True
While HorNameExists 'İs true
HorNameExists = False 'setting variable to false imidiately
For Each param As Inventor.Parameter In params ' iterates over all existing parameters in the part document to check if the name already exists
If param.Name = newNameHor Then
HorNameExists = True 'setting variable to true if name matches found
Exit For ' exits for each loop with setting variable to true in order to keep the while loop running
End If
Next
If HorNameExists Then ' if variable is true, program gets into if
indexHor += 1 ' rise up one by one
newNameHor = horDimName & indexHor.ToString() ' assign new name
End If
End While 'ends while if variable is false as set at the beginning of loop / iterates again if variable is true
horizontalDim.Parameter.Name = newNameHor ' asigns new name
Catch ex As Exception
MessageBox.Show("Error adding horizontal dimension: " & ex.Message)
End Try
Try ' Add vertical dimension constraint
Dim verticalDim As DimensionConstraint
verticalDim = sketchtoApplyDims.DimensionConstraints.AddTwoPointDistance(oLine3.StartSketchPoint, oLine3.EndSketchPoint, DimensionOrientationEnum.kHorizontalDim, oLengthDimPositionHorizontal)
Dim newNameVer As String = verDimName & indexVer.ToString()
Dim VerNameExists As Boolean = True
While VerNameExists ' same as above
VerNameExists=False
For Each param As Inventor.Parameter In params
If param.Name = newNameVer Then
VerNameExists = True
Exit For
End If
Next
If VerNameExists Then
indexVer += 1
newNameVer = verDimName & indexVer.ToString()
End If
End While
verticalDim.Parameter.Name = newNameVer
Catch ex As Exception
MessageBox.Show("Error adding vertical dimension: " & ex.Message)
End Try
Return sketchtoApplyDims.SketchPoints.Item(sketchtoApplyDims.SketchPoints.Count) ' Return the last added SketchPoint
End Function
Function GetRectangleDimensions(thingCount As Byte, ByRef donetoFinish As Boolean) As Tuple(Of Double, Double)
Dim Inputlength As Double = 0.0
Dim Inputwidth As Double = 0.0
Inputlength = GetValidatedInput("Enter the length of the " & thingCount.ToString() & " rectangle (or type 'd' to finish)", "Rectangle", donetoFinish) ' Get length with validation
If donetoFinish Then Return Nothing ' Exit if the user finishes input during length entry
Do
Inputwidth = GetValidatedInput("Enter the width of the " & thingCount.ToString() & " rectangle ", "Rectangle", donetoFinish) ' Get width with validation, user cannot exit here
If donetoFinish Then
donetoFinish = False ' Reset done flag so that the user cannot exit at this stage
MessageBox.Show("You can't finish without specifying the width for this rectangle!", "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
Else
Exit Do ' Exit loop if a valid width is entered
End If
Loop
Return Tuple.Create(Inputlength, Inputwidth)
End Function
Function GetValidatedInput(prompt As String, title As String, ByRef isDonetoValid As Boolean) As Double
Dim validInput As Boolean = False
Dim result As Double = 0
While Not validInput
Dim input As String = InputBox(prompt, title)
If input.ToLower() = "d" Then
isDonetoValid = True
Return 0 ' Return 0 or any default value if "d" is entered
End If
Try
result = CDbl(input)
If result > 0 Then
validInput = True ' Valid input only if it's positive
Else
MessageBox.Show("Value must be a positive number. Please enter a valid value.", "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
End If
Catch ex As Exception
MessageBox.Show("Invalid input! Please enter numeric values.", "Error", MessageBoxButtons.OKCancel, MessageBoxIcon.Error)
End Try
End While
Return result
End Function
Function CheckYSketchAxis (ComponentDefinition As PartComponentDefinition, Sketch As PlanarSketch) As SketchLine
Dim SketchYAxis As SketchLine = Sketch.AddByProjectingEntity(ComponentDefinition.WorkAxes(2))
Return SketchYAxis
End Function
Function CoincidentConstraint(Basepoint As SketchPoint, SecondPointtoSellect As SketchPoint, SketchforCoincidentConstraint As PlanarSketch)
Try
Return SketchforCoincidentConstraint.GeometricConstraints.AddCoincident(Basepoint, SecondPointtoSellect)
Catch ex As Exception ' Handle the exception if needed
End Try
End Function
Function MidpointConstraint(Point As SketchPoint, baseLine As SketchLine, SketchforMidpointConstraint As PlanarSketch)
Try
Return SketchforMidpointConstraint.GeometricConstraints.AddMidpoint(Point, baseLine)
Catch ex As Exception ' Handle the exception if needed
End Try
End Function
Function AddSymmetryForRectangle(Sketch As PlanarSketch, thingforBase As SketchEntitiesEnumerator, thingforSymmetry As SketchEntitiesEnumerator, symmetryLine As SketchLine)
Try
Dim lineCount As Integer = thingforBase.Count ' Get the count of lines in the rectangle
For i As Integer = 1 To lineCount ' Loop through all lines dynamically
Sketch.GeometricConstraints.AddSymmetry(thingforBase(i), thingforSymmetry(i), symmetryLine)
Next
Catch ex As Exception
MessageBox.Show("Symmetry Constraint failed: " & ex.Message)
End Try
End Function
Function CheckOriginSketchPoint(ComponentDefinition As PartComponentDefinition, Sketch As PlanarSketch) As SketchPoint
Dim OriginSketchPoint As SketchPoint = Nothing
For Each pSketchPoint As SketchPoint In Sketch.SketchPoints
If pSketchPoint.ReferencedEntity IsNot Nothing Then
OriginSketchPoint = pSketchPoint
Exit For
End If
Next
If OriginSketchPoint Is Nothing Then
OriginSketchPoint = Sketch.AddByProjectingEntity(ComponentDefinition.WorkPoints(1))
End If
Return OriginSketchPoint
End Function
Function DrawRectangle(sketchforRect As PlanarSketch, length As Double, width As Double) As SketchEntitiesEnumerator
If length <= 0 Or width <= 0 Then ' Validate dimensions
MessageBox.Show("Invalid dimensions: length=" & length & ", width=" & width)
Return Nothing ' Return Nothing in case of invalid input
End If
' Create points
Dim centerPoint As Point2d = ThisApplication.TransientGeometry.CreatePoint2d(0, 0)
Dim cornerPoint As Point2d = ThisApplication.TransientGeometry.CreatePoint2d(width/10, length/10)
' Validate points
If centerPoint Is Nothing Or cornerPoint Is Nothing Then
MessageBox.Show("Invalid points: Center or Corner point is null")
Return Nothing ' Return Nothing if points are not valid
End If
Try
Return sketchforRect.SketchLines.AddAsTwoPointRectangle(centerPoint, cornerPoint) ' Add rectangle
Catch ex As Exception
MessageBox.Show("Error adding rectangle: " & ex.Message)
Return Nothing ' Return Nothing on failure
End Try
End Function
Function GetMidpointOfLinesMiddlePoint(sketchforMidPoint As PlanarSketch, oRectangleLines As SketchEntitiesEnumerator) As SketchPoint
Dim midpointSketchPoint As SketchPoint = sketchforMidPoint.SketchPoints.Add(ThisApplication.TransientGeometry.CreatePoint2d(2, 1))
MidpointConstraint(midpointSketchPoint, oRectangleLines(4) , sketchforMidPoint)
Return midpointSketchPoint ' Return the midpoint as a Point2d object
End Function
Function GetRectThirdlineMidPoint(sketchforMidPoint As PlanarSketch, oRectangleLines As SketchEntitiesEnumerator) As SketchPoint
Dim midpointRectThirdLinePoint As SketchPoint = sketchforMidPoint.SketchPoints.Add(ThisApplication.TransientGeometry.CreatePoint2d(3, 2))
MidpointConstraint(midpointRectThirdLinePoint, oRectangleLines(2) , sketchforMidPoint)
Return midpointRectThirdLinePoint ' Return the midpoint as a Point2d object
End Function
Sub ShowList(Things As List(Of Tuple(Of Double, Double)))
Dim TotalThings As Byte = Things.Count
Dim thingListString As String = "Total number of rectangles: " & TotalThings.ToString()
thingListString &= vbCrLf & "Current list of rectangles:" & vbCrLf
For Each thing As Tuple(Of Double, Double) In Things
thingListString &= "Length: " & thing.Item1 & ", Width: " & thing.Item2 & vbCrLf
Next
MessageBox.Show(thingListString, "Rectangle List", MessageBoxButtons.OK, MessageBoxIcon.Information)
End Sub
Function DocumentTypeValidation ( oSession As Inventor.Application ) As Boolean
If oSession.ActiveDocument Is Nothing Then
MsgBox("No active document found.")
Return False
End If
Dim Doc As PartDocument = TryCast(oSession.ActiveDocument, PartDocument)
If Doc Is Nothing Then
MessageBox.Show("This rule works with part documents only.", "iLogic Rule",MessageBoxButtons.OK, MessageBoxIcon.Warning)
Return False
End If
Return True ' If the function reaches here, the active document is a part document
End Function
@J-Camper Hi again 🙂 Hope this response will not be deleted at all because I couldn't post this response for 2 or 3 times. Thank you for your response and wise approach, it helped me a lot. I first draw my actual rect and random rect as second. then created the function like this
Function AddSymmetryForRectangle(Sketch As PlanarSketch, thingforBase As SketchEntitiesEnumerator, thingforSymmetry As SketchEntitiesEnumerator, symmetryLine As SketchLine)
Try
Dim lineCount As Integer = thingforBase.Count ' Get the count of lines in the rectangle
For i As Integer = 1 To lineCount ' Loop through all lines dynamically
Sketch.GeometricConstraints.AddSymmetry(thingforBase(i), thingforSymmetry(i), symmetryLine)
Next
Catch ex As Exception
MessageBox.Show("Symmetry Constraint failed: " & ex.Message)
End Try
End Function
Then used it in main sub like this
AddSymmetryForRectangle(SketchforCore, currentRectangleLines, symmetryRect, symmetryLine) ' Apply symmetry constraints to the rectangle
and end product is this
İts the almost end of this stage 🙂 . As last question, I wanted to relocate dimensions to a proper positions but seems like couldn't menage to do that. First I stored them in Lists regarding their classes like this
Function AlignHorizontalAndVerticalDimensions(activeSketch As PlanarSketch) As Boolean
Dim horDims As New List(Of DimensionConstraint)
Dim verDims As New List(Of DimensionConstraint)
Dim oDim As DimensionConstraint
For Each oDim In activeSketch.DimensionConstraints
MessageBox.Show("For succeed")
' Check for horizontal and vertical dimensions using DimensionTypeEnum
If oDim.Type = DimensionTypeEnum.kHorizontalDimensionType Then
oDim.TextPoint = ThisApplication.TransientGeometry.CreatePoint2d(5, 7)
MessageBox.Show("Horizontal dimension aligned")
horDims.Add(oDim) ' Store the horizontal dimension if needed
ElseIf oDim.Type = DimensionTypeEnum.kVerticalDimensionType Then
oDim.TextPoint = ThisApplication.TransientGeometry.CreatePoint2d(15, 8)
MessageBox.Show("Vertical dimension aligned")
verDims.Add(oDim) ' Store the vertical dimension if needed
End If
Next
Return True
End Function
and used it in main sub but didnt work so far. Is there any suggestion ?
From that, I will open new topic to ask new question 🙂
