@harvey3ELEA,
Try This:
Public Sub SketchCreation()
Dim aeDoc As Document = ThisApplication.ActiveEditDocument
'Prompt to select face to create new sketch
Dim Sketch As PlanarSketch = aeDoc.ComponentDefinition.Sketches.Add(ThisApplication.CommandManager.Pick(kPartFacePlanarFilter, "Pick face to add sketch"), True)
If sketch Is Nothing Then MessageBox.Show("No face selected to create a sketch on.", "Early Exit") :Exit Sub
'get origin point in 2D space
Dim oOriginSketchPoint As SketchPoint = sketch.AddByProjectingEntity(aeDoc.ComponentDefinition.WorkPoints.Item(1))
'[Get size of rectangle
Dim X As Double = 1
Dim Y As Double = 1
Dim Xinput As String = InputBox(Prompt :="X dimension [input as inches].", Title :="X size", DefaultResponse := X)
If Xinput Is String.Empty Then sketch.Delete() : Exit Sub
Dim Yinput As String = InputBox(Prompt:="Y dimension [input as inches].", Title:="Y size", DefaultResponse:= Y)
If Yinput Is String.Empty Then sketch.Delete() : Exit Sub
'get doubles from strings
Try
X = Abs(CDbl(Xinput)) * 2.54 'convert expected inches to cm for database
Catch
MessageBox.Show(String.Format("User input: {0} could not be converted to Double.", Xinput), "Early Exit") : sketch.Delete() : Exit Sub
End Try
Try
Y = Abs(CDbl(Yinput)) * 2.54 'convert expected inches to cm for database
Catch
MessageBox.Show(String.Format("User input: {0} could not be converted to Double.", Yinput), "Early Exit") : sketch.Delete() : Exit Sub
End Try
'Exit if 0 is entered for either X or Y
If X*Y = 0 Then MessageBox.Show(String.Format("Both values X({0}) and Y({1}) need to be non-zero.", X, Y), "Early Exit") : sketch.Delete() : Exit Sub
']
'[Get array count of rectangle
Dim XQTY As Integer = 2
Dim YQTY As Integer = 2
Dim XQTYinput As String = InputBox(Prompt :="Quantity on holes in X direction.", Title :="X count", DefaultResponse := XQTY)
Dim YQTYinput As String = InputBox(Prompt:="Quantity on holes in Y direction.", Title :="Y count", DefaultResponse := YQTY)
'get integers from strings
Try
XQTY = Round(Abs(CDbl(XQTYinput)))
Catch : End Try
Try
YQTY = Round(Abs(CDbl(YQTYinput)))
Catch : End Try
If XQTY < 2 Then XQTY = 2 'Enforce min value
If YQTY < 2 Then YQTY = 2 'Enforce min value
']
'[Create Initial Rectangle
'Create second point to make rectangle
Dim RectangleCorner As Point2d = oOriginSketchPoint.Geometry.Copy
RectangleCorner.X += X / 2
RectangleCorner.Y += Y / 2
' Draw rectangles by center point.
Dim RectangleLines As SketchEntitiesEnumerator = sketch.SketchLines.AddAsTwoPointCenteredRectangle(oOriginSketchPoint, RectangleCorner)
'Add dimensions to two sides of rectangle
Dim TextPointHorizontal As Point2d = oOriginSketchPoint.Geometry.Copy
TextPointHorizontal.Y += Y*.55 '5% beyond geometry
Dim TextPointVertical As Point2d = oOriginSketchPoint.Geometry.Copy
TextPointVertical.X += X*.55 '5% beyond geometry
Dim HorizontalParam As Inventor.Parameter = sketch.DimensionConstraints.AddTwoPointDistance(RectangleLines.Item(3).StartSketchPoint, RectangleLines.Item(3).EndSketchPoint, kHorizontalDim , TextPointHorizontal, False).Parameter
Dim VerticalParam As Inventor.Parameter = sketch.DimensionConstraints.AddTwoPointDistance(RectangleLines.Item(2).StartSketchPoint, RectangleLines.Item(2).EndSketchPoint, kVerticalDim , TextPointVertical , False).Parameter
'prep for arrays
Dim BottomLine, RightLine, TopLine, LeftLine As SketchLine
'Set all rectangle corners to be a centerpoint
For Each skLine As SketchLine In RectangleLines.OfType(Of SketchLine)
'This appears to be a fixed draw order
If BottomLine Is Nothing
BottomLine = skLine
Else If RightLine Is Nothing
RightLine = skLine
Else If TopLine Is Nothing
TopLine = skLine
Else If LeftLine Is Nothing
LeftLine = skLine
End If
skLine.StartSketchPoint.HoleCenter = True
skLine.EndSketchPoint.HoleCenter = True
i+=1
Next
']
'Create arrays if needed
If XQTY <= 2 And YQTY <= 2 Then sketch.Solve() : Exit Sub 'No arrays
If XQTY > 2 Then Call AddArrayAlongLine(sketch, XQTY, TopLine, BottomLine, LeftLine, HorizontalParam, DimensionOrientationEnum.kHorizontalDim)
If YQTY > 2 Then Call AddArrayAlongLine(sketch, YQTY, LeftLine, RightLine, BottomLine, VerticalParam, DimensionOrientationEnum.kVerticalDim)
sketch.Solve()
End Sub
Sub AddArrayAlongLine(aSketch As PlanarSketch, HoleQuantity As Integer, StartLine As SketchLine, EndLine As SketchLine, PerpendicularLine As SketchLine, SpanningParameter As Inventor.Parameter, Orientation As DimensionOrientationEnum)
Dim Length As Double = SpanningParameter.Value
Dim Spacing As Double = Length / (HoleQuantity - 1)
Dim StartPoint As SketchPoint = Nothing
Dim EndPoint As SketchPoint = Nothing
Dim Counting As Integer = 2
While Counting < HoleQuantity
'StartFresh if no memory
If StartPoint Is Nothing Then
StartPoint = PerpendicularLine.StartSketchPoint
EndPoint = PerpendicularLine.EndSketchPoint
End If
'Locate new Points
Dim newStartPoint As Point2d = StartPoint.Geometry.Copy
Dim newEndPoint As Point2d = EndPoint.Geometry.Copy
Dim TranslationVector As Vector2d = EndLine.Geometry.Direction.AsVector
TranslationVector.ScaleBy(Spacing)
newStartPoint.TranslateBy(TranslationVector)
newEndPoint.TranslateBy(TranslationVector)
'Create new Points
Dim newStartSketchPoint As SketchPoint = aSketch.SketchPoints.Add(newStartPoint, True)
Dim newEndSketchPoint As SketchPoint = aSketch.SketchPoints.Add(newEndPoint, True)
aSketch.GeometricConstraints.AddCoincident(newStartSketchPoint, StartLine)
aSketch.GeometricConstraints.AddCoincident(newEndSketchPoint, EndLine)
'TextPoints
TranslationVector.ScaleBy(.5)
Dim StartTextPoint As Point2d = StartPoint.Geometry.Copy
StartTextPoint.TranslateBy(TranslationVector)'
Dim EndTextPoint As Point2d = EndPoint.Geometry.Copy
EndTextPoint.TranslateBy(TranslationVector)
'Dimension Constraints
aSketch.DimensionConstraints.AddTwoPointDistance(StartPoint, newStartSketchPoint, Orientation, StartTextPoint, False).Parameter.Expression = String.Format("{0}/{1}", SpanningParameter.Name, (HoleQuantity-1))
aSketch.DimensionConstraints.AddTwoPointDistance(EndPoint, newEndSketchPoint, Orientation , EndTextPoint, False).Parameter.Expression = String.Format("{0}/{1}", SpanningParameter.Name, (HoleQuantity-1))
'Memory
StartPoint = newStartSketchPoint
EndPoint = newEndSketchPoint
Counting +=1
End While
End Sub
I made some additions to the primary routine and added an array routine. It only works for rectangles as is. It could be rewritten to do polygons, with each line arrayed separately, but you would end up needing a user input for each line. I did not spend time trying to develop a logical way to move the text point off the line.
Let me know if you have any questions, or if this is not working as intended
