Untitled diff
123 lines
Option explicit on
Dim oPartDoc As Document = ThisDoc.Document
Dim oPartDoc As Document = ThisDoc.Document
Dim oPartCompDef As PartComponentDefinition = ThisApplication.ActiveDocument.ComponentDefinition
Dim oPartCompDef As PartComponentDefinition = ThisApplication.ActiveDocument.ComponentDefinition
Dim oTG As TransientGeometry = ThisApplication.TransientGeometry
Dim oTG As TransientGeometry = ThisApplication.TransientGeometry
'get measurements to determine Material Thickness
'get measurements to determine Material Thickness
My_x = Measure.ExtentsLength
Dim My_x As Double = Measure.ExtentsLength
My_y = Measure.ExtentsWidth
Dim My_y As Double = Measure.ExtentsWidth
My_z = Measure.ExtentsHeight
Dim My_z As Double = Measure.ExtentsHeight
'Make shortest value the Thickness, rounded to 4 places
'Make shortest value the Thickness, rounded to 4 places
oThickness = Round(MinOfMany(My_x, My_y, My_z), 4)
Dim oThickness As Double = Round(MinOfMany(My_x, My_y, My_z), 4)
'Select Face and Edges to dimension sketch circles from
'Select Face and Edges to dimension sketch circles from
Dim oFace As Face = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kPartFaceFilter, "Select Surface to Place Holes")
Dim oFace As Face = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kPartFaceFilter, "Select Surface to Place Holes")
Dim oFrontEdge As Edge = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kPartEdgeFilter, "Select Front Edge of Pattern")
Dim oFrontEdge As Edge = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kPartEdgeFilter, "Select Front Edge of Pattern")
Dim oLeftEdge As Edge = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kPartEdgeFilter, "Select Left Edge of Pattern")
Dim oLeftEdge As Edge = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kPartEdgeFilter, "Select Left Edge of Pattern")
Dim oRightEdge As Edge = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kPartEdgeFilter, "Select Right Edge of Pattern")
Dim oRightEdge As Edge = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kPartEdgeFilter, "Select Right Edge of Pattern")
Dim oWorkPoint As WorkPoint = oPartCompDef.WorkPoints.AddByTwoLines(oFrontEdge, oLeftEdge)
Dim oWorkPoint As WorkPoint = oPartCompDef.WorkPoints.AddByTwoLines(oFrontEdge, oLeftEdge)
oMaterial = MaterialType
Dim oMaterial As String = MaterialType
oHoleType = HoleType
Dim oHoleType As String = HoleType
oHoleSize = HoleSizes * 2.54
Dim oHoleSize As Double = HoleSizes * 2.54
'Add Sketch and set sketch origin point to the startVertex of the FrontEdge
'Add Sketch and set sketch origin point to the startVertex of the FrontEdge
Dim oSketch As PlanarSketch
Dim oSketch As PlanarSketch
oSketch = oPartCompDef.Sketches.Add(oFace, False)
oSketch = oPartCompDef.Sketches.Add(oFace, False)
oSketch.AxisEntity = oFrontEdge
oSketch.AxisEntity = oFrontEdge
oSketch.OriginPoint = oFrontEdge.StartVertex
oSketch.OriginPoint = oFrontEdge.StartVertex
'Create the name for the sketch based on user assigned parameters
'Create the name for the sketch based on user assigned parameters
Dim oSketchNameSuffix As Integer
Dim oSketchNameSuffix As Integer
Dim oNameCompare As String
Dim oNameCompare As String
Dim oNameNumCount As Integer
Dim oNameNumCount As Integer
Dim oNameCharCount As Integer
Dim oNameCharCount As Integer
If oHoleType = "Thru" Then
If oHoleType = "Thru" Then
oSketchNameSuffix = 0
oSketchNameSuffix = 0
oNameCompare = "SK_Hole_"
oNameCompare = "SK_Hole_"
oNameCharCount = 8
oNameCharCount = 8
oNameNumCount = 9
oNameNumCount = 9
Else If oHoleType = "Pilot" Then
Else If oHoleType = "Pilot" Then
oSketchNameSuffix = 0
oSketchNameSuffix = 0
oNameCompare = "SK_Pilot_"
oNameCompare = "SK_Pilot_"
oNameCharCount = 9
oNameCharCount = 9
oNameNumCount = 10
oNameNumCount = 10
End If
End If
'Check all sketches in the model tree and compare the names to the
'Check all sketches in the model tree and compare the names to the
'name of the newly created sketch and if name exists increment the
'name of the newly created sketch and if name exists increment the
'suffix by 1. Continue until the newly created sketch name is unique
'suffix by 1. Continue until the newly created sketch name is unique
'and can be used.
'and can be used.
For Each oSketchNameCheck As Sketch In oPartCompDef.Sketches
For Each oSketchNameCheck As Sketch In oPartCompDef.Sketches
If Left(oSketchNameCheck.Name,oNameCharCount) = oNameCompare Then
If Left(oSketchNameCheck.Name,oNameCharCount) = oNameCompare Then
oSketchNumber = Val(Mid(oSketchNameCheck.Name, oNameNumCount, 2))
Dim oSketchNumber As Integer = Val(Mid(oSketchNameCheck.Name, oNameNumCount, 2))
While oSketchNameSuffix <= oSketchNumber
While oSketchNameSuffix <= oSketchNumber
oSketchNameSuffix = oSketchNameSuffix + 1
oSketchNameSuffix = oSketchNameSuffix + 1
End While
End While
End If
End If
Next
Next
oSketch.Name = oNameCompare & oSketchNameSuffix
oSketch.Name = oNameCompare & oSketchNameSuffix
'QTY of holes and distance from front, left and right edges
'QTY of holes and distance from front, left and right edges
Dim oQty = 4
Dim oQty = 4
oFromLeftEdge = FromLeftEdge * 2.54
Dim oFromLeftEdge As Double = FromLeftEdge * 2.54
oFromRightEdge = FromRightEdge * 2.54
Dim oFromRightEdge As Double = FromRightEdge * 2.54
oFromFrontEdge = FromFrontEdge * 2.54
Dim oFromFrontEdge As Double = FromFrontEdge * 2.54
Dim oFrontEdgeDistance = ThisApplication.MeasureTools.GetMinimumDistance(oFrontEdge.StartVertex, oFrontEdge.StopVertex)
Dim oFrontEdgeDistance As Double = ThisApplication.MeasureTools.GetMinimumDistance(oFrontEdge.StartVertex, oFrontEdge.StopVertex)
Dim oPatternSpacing = (oFrontEdgeDistance -(oFromLeftEdge + oFromRightEdge)) / (oQty-1)
Dim oPatternSpacing As Double = (oFrontEdgeDistance -(oFromLeftEdge + oFromRightEdge)) / (oQty-1)
'create a sketch point to check if the coordinate system needs
'create a sketch point to check if the coordinate system needs
'To be flipped so the circles fall inside the parent part.
'To be flipped so the circles fall inside the parent part.
oWPlanes = ThisDoc.Document.ComponentDefinition.WorkPlanes
Dim oWPlanes As WorkPlanes = ThisDoc.Document.ComponentDefinition.WorkPlanes
oPlane = oWPlanes.Item(2).Name
Dim oPlane As WorkPlane = oWPlanes.Item(2)
MessageBox.Show(oPlane,"iLogic")
MessageBox.Show(oPlane.Name,"iLogic")
Dim oSketchPoint As SketchPoint = oSketch.SketchPoints.Add(oTG.CreatePoint2d(oFromLeftEdge, oFromFrontEdge))
Dim oSketchPoint As SketchPoint = oSketch.SketchPoints.Add(oTG.CreatePoint2d(oFromLeftEdge, oFromFrontEdge))
Dim circleParentSketch As PlanarSketch = oSketchPoint.Parent
Dim circleParentSketch As PlanarSketch = oSketchPoint.Parent
Dim vectorForCheck As UnitVector = circleParentSketch.PlanarEntityGeometry.Normal
Dim vectorForCheck As UnitVector = circleParentSketch.PlanarEntityGeometry.Normal
Dim pointToCheck As Point = oSketchPoint.Geometry3d
Dim pointToCheck As Point = oSketchPoint.Geometry3d
Dim foundObjects As ObjectsEnumerator = Nothing
Dim foundObjects As ObjectsEnumerator = Nothing
Dim locationPoints As ObjectsEnumerator = Nothing
Dim locationPoints As ObjectsEnumerator = Nothing
oPartCompDef.FindUsingRay(pointToCheck, vectorForCheck, .00001, foundObjects, locationPoints)
oPartCompDef.FindUsingRay(pointToCheck, vectorForCheck, .00001, foundObjects, locationPoints)
If oPlane.IsPerpendicularTo(oSketch, 15) Then
If oPlane.Plane.IsPerpendicularTo(oSketch, 15) Then
If (foundObjects.Count = 0) Then
If (foundObjects.Count = 0) Then
MessageBox.Show("No Intersection Found", "iLogic")
MessageBox.Show("No Intersection Found", "iLogic")
oSketch.NaturalAxisDirection = False
oSketch.NaturalAxisDirection = False
Else If (foundObjects.Count > 0) Then
Else If (foundObjects.Count > 0) Then
MessageBox.Show("Intersection Found", "iLogic")
MessageBox.Show("Intersection Found", "iLogic")
oSketch.NaturalAxisDirection = True
oSketch.NaturalAxisDirection = True
End If
End If
Else
Else
If (foundObjects.Count = 0) Then
If (foundObjects.Count = 0) Then
MessageBox.Show("No Intersection Found", "iLogic")
MessageBox.Show("No Intersection Found", "iLogic")
oSketch.NaturalAxisDirection = True
oSketch.NaturalAxisDirection = True
Else If (foundObjects.Count > 0) Then
Else If (foundObjects.Count > 0) Then
MessageBox.Show("Intersection Found", "iLogic")
MessageBox.Show("Intersection Found", "iLogic")
oSketch.NaturalAxisDirection = False
oSketch.NaturalAxisDirection = False
End If
End If
End If
End If
oSketchPoint.Delete
oSketchPoint.Delete
'create the sketch circles
'create the sketch circles
For i = 0 To oQty - 1
For i = 0 To oQty - 1
Dim oCircle As SketchCircle = oSketch.SketchCircles.AddByCenterRadius(oTG.CreatePoint2d(oFromLeftEdge + (i * oPatternSpacing), oFromFrontEdge), (oHoleSize/2))
Dim oCircle As SketchCircle = oSketch.SketchCircles.AddByCenterRadius(oTG.CreatePoint2d(oFromLeftEdge + (i * oPatternSpacing), oFromFrontEdge), (oHoleSize/2))
Next
Next
'extrude cut the holes from the parent part.
'extrude cut the holes from the parent part.
Dim oProfile As Profile = oSketch.Profiles.AddForSolid
Dim oProfile As Profile = oSketch.Profiles.AddForSolid
Dim oExtrude As ExtrudeFeature = oPartCompDef.Features.ExtrudeFeatures.AddByDistanceExtent(oProfile, oThickness*2.54, kNegativeExtentDirection, kCutOperation)
Dim oExtrude As ExtrudeFeature = oPartCompDef.Features.ExtrudeFeatures.AddByDistanceExtent(oProfile, oThickness*2.54, kNegativeExtentDirection, kCutOperation)