UG二次开发源码-链轮齿轮标准件创建VB源码
UG二次开发源码-链轮齿轮标准件创建VB源码感觉还不错，VB写的分享下，只是这里没有使用渐开线的方式画齿轮！
Private Function CreateChainGear(ByVal ChainType As String, ByVal Z As Integer) As Integer
Dim errorCode As Integer = 0
Dim p, dr, d, r1, r2, r3, da, d_cut As Double
Dim alf, Beta, Gama As Double
Dim M, T, V, W As Double
Dim DtoR As Double = PI / 180
Try
Select Case ChainType
Case "06B"
p = 9.525
dr = 6.35
Case "08A"
p = 12.7
dr = 7.95
Case "08B"
p = 12.7
dr = 8.51
Case "10A"
p = 15.875
dr = 10.16
End Select
alf = (55 - 60 / Z) * DtoR
Beta = (18 - 56 / Z) * DtoR
Gama = (17 - 64 / Z) * DtoR
r1 = 0.5025 * dr + 0.05
r2 = 1.3025 * dr + 0.05
r3 = dr * (1.3 * Cos(Gama) + 0.8 * Cos(Beta) - 1.3025) - 0.05
M = 0.8 * dr * Sin(alf)
T = 0.8 * dr * Cos(alf)
W = 1.3 * dr * Cos(180 / Z * DtoR)
V = 1.3 * dr * Sin(180 / Z * DtoR)
d = p / Sin(180 / Z * DtoR)
da = p * (0.54 + 1 / Tan(180 / Z * DtoR))
d_cut = p * (1 + 1 / Tan(180 / Z * DtoR))
Dim Point_O, Point_O2, Point_O3, Point_A, Point_B, Point_C, Point_D, Point_E, Point_cut As Point3d
Dim Y_o As Double = d / 2
Point_O = New Point3d(0, Y_o, 0)
Point_O2 = New Point3d(-M, Y_o + T, 0)
Dim point_O2_neg As Point3d = New Point3d(M, Y_o + T, 0)
Point_O3 = New Point3d(W, Y_o - V, 0)
Dim point_O3_neg As Point3d = New Point3d(-W, Y_o - V, 0)
Point_A = New Point3d(r1 * Sin(alf), Y_o - r1 * Cos(alf), 0)
Dim Point_A_neg As Point3d = New Point3d(-r1 * Sin(alf), Y_o - r1 * Cos(alf), 0)
Point_B = New Point3d(-M + r2 * Sin(alf + Beta), Y_o + T - r2 * Cos(alf + Beta), 0)
Dim Point_B_neg As Point3d = New Point3d(M - r2 * Sin(alf + Beta), Y_o + T - r2 * Cos(alf + Beta), 0)
Point_C = New Point3d(W - r3 * Sin(alf + Beta), Y_o - V + r3 * Cos(alf + Beta), 0)
Dim Point_C_neg As Point3d = New Point3d(-W + r3 * Sin(alf + Beta), Y_o - V + r3 * Cos(alf + Beta), 0)
Dim X_d As Double = W - r3 * Cos(90 * DtoR - alf - Beta + Gama)
Dim Y_d As Double = Y_o - V + r3 * Sin(90 * DtoR - alf - Beta + Gama)
Point_D = New Point3d(X_d, Y_d, 0)
Dim Point_D_neg As Point3d = New Point3d(-X_d, Y_d, 0)
Dim Ld As Double = Y_d - X_d / Tan(180 / Z * DtoR)
Dim Le As Double = Ld * Cos(180 / Z * DtoR)
Point_E = New Point3d(X_d + Le * Sin(180 / Z * DtoR), Y_d - Ld + Le * Cos(180 / Z * DtoR), 0)
Dim Point_E_neg As Point3d = New Point3d(-X_d - Le * Sin(180 / Z * DtoR), Y_d - Ld + Le * Cos(180 / Z * DtoR), 0)
Point_cut = New Point3d(d_cut / 2 * Sin(180 / Z * DtoR), d_cut / 2 * Cos(180 / Z * DtoR), 0)
Dim Point_cut_neg As Point3d = New Point3d(-d_cut / 2 * Sin(180 / Z * DtoR), d_cut / 2 * Cos(180 / Z * DtoR), 0)
theSession.Preferences.Sketch.CreateInferredConstraints = False
theSession.Preferences.Sketch.ContinuousAutoDimensioning = False
Dim workPart As Part = theSession.Parts.Work
Dim nullSketch As Sketch = Nothing
Dim sketchInPlaceBuilder1 As SketchInPlaceBuilder
sketchInPlaceBuilder1 = workPart.Sketches.CreateNewSketchInPlaceBuilder(nullSketch)
Dim Cut_sketch As Sketch
Cut_sketch = sketchInPlaceBuilder1.Commit()
Cut_sketch.SetName("Sketch_ChainGear")
Cut_sketch.Activate(Sketch.ViewReorient.False)
Dim nXMatrix1 As NXMatrix
nXMatrix1 = theSession.ActiveSketch.Orientation
Dim arc As Arc
arc = workPart.Curves.CreateArc(Point_O, nXMatrix1, r1, -90 * DtoR - alf, -90 * DtoR + alf)
theSession.ActiveSketch.AddGeometry(arc, Sketch.InferConstraintsOption.InferNoConstraints)
arc = workPart.Curves.CreateArc(Point_O2, nXMatrix1, r2, -90 * DtoR + alf, -90 * DtoR + alf + Beta)
theSession.ActiveSketch.AddGeometry(arc, Sketch.InferConstraintsOption.InferNoConstraints)
arc = workPart.Curves.CreateArc(point_O2_neg, nXMatrix1, r2, -90 * DtoR - alf - Beta, -90 * DtoR - alf)
theSession.ActiveSketch.AddGeometry(arc, Sketch.InferConstraintsOption.InferNoConstraints)
arc = workPart.Curves.CreateArc(Point_O3, nXMatrix1, r3, 90 * DtoR + alf + Beta - Gama, 90 * DtoR + alf + Beta)
theSession.ActiveSketch.AddGeometry(arc, Sketch.InferConstraintsOption.InferNoConstraints)
arc = workPart.Curves.CreateArc(point_O3_neg, nXMatrix1, r3, 90 * DtoR - alf - Beta, 90 * DtoR - alf - Beta + Gama)
theSession.ActiveSketch.AddGeometry(arc, Sketch.InferConstraintsOption.InferNoConstraints)
Dim line1 As Line
line1 = workPart.Curves.CreateLine(Point_B, Point_C)
theSession.ActiveSketch.AddGeometry(line1, Sketch.InferConstraintsOption.InferNoConstraints)
line1 = workPart.Curves.CreateLine(Point_B_neg, Point_C_neg)
theSession.ActiveSketch.AddGeometry(line1, Sketch.InferConstraintsOption.InferNoConstraints)
line1 = workPart.Curves.CreateLine(Point_D, Point_E)
theSession.ActiveSketch.AddGeometry(line1, Sketch.InferConstraintsOption.InferNoConstraints)
line1 = workPart.Curves.CreateLine(Point_D_neg, Point_E_neg)
theSession.ActiveSketch.AddGeometry(line1, Sketch.InferConstraintsOption.InferNoConstraints)
line1 = workPart.Curves.CreateLine(Point_E, Point_cut)
theSession.ActiveSketch.AddGeometry(line1, Sketch.InferConstraintsOption.InferNoConstraints)
line1 = workPart.Curves.CreateLine(Point_E_neg, Point_cut_neg)
theSession.ActiveSketch.AddGeometry(line1, Sketch.InferConstraintsOption.InferNoConstraints)
Dim Point_center As Point3d = New Point3d(0, 0, 0)
arc = workPart.Curves.CreateArc(Point_center, nXMatrix1, d_cut / 2, (90 - 180 / Z) * DtoR, (90 + 180 / Z) * DtoR)
theSession.ActiveSketch.AddGeometry(arc, Sketch.InferConstraintsOption.InferNoConstraints)
theSession.ActiveSketch.Update()
theSession.ActiveSketch.Deactivate(Sketch.ViewReorient.False, Sketch.UpdateLevel.Model)
sketchInPlaceBuilder1 = workPart.Sketches.CreateNewSketchInPlaceBuilder(nullSketch)
Dim Circle_sketch As Sketch
Circle_sketch = sketchInPlaceBuilder1.Commit()
Circle_sketch.SetName("Sketch_Circle")
Circle_sketch.Activate(Sketch.ViewReorient.False)
arc = workPart.Curves.CreateArc(Point_center, nXMatrix1, da / 2, 0, 360 * DtoR)
theSession.ActiveSketch.AddGeometry(arc, Sketch.InferConstraintsOption.InferNoConstraints)
theSession.ActiveSketch.Update()
theSession.ActiveSketch.Deactivate(Sketch.ViewReorient.False, Sketch.UpdateLevel.Model)
sketchInPlaceBuilder1.Destroy()
Dim nullFeatures_Feature As Features.Feature = Nothing
Dim nullNXObject As NXObject = Nothing
Dim nullPoint As Point = Nothing
Dim extrudeBuilder1 As Features.ExtrudeBuilder
extrudeBuilder1 = workPart.Features.CreateExtrudeBuilder(nullFeatures_Feature)
extrudeBuilder1.Limits.StartExtend.Value.RightHandSide = "0"
extrudeBuilder1.Limits.EndExtend.Value.RightHandSide = "5"
Dim targetBodies1(0) As Body
Dim nullBody As Body = Nothing
targetBodies1(0) = nullBody
extrudeBuilder1.BooleanOperation.SetTargetBodies(targetBodies1)
extrudeBuilder1.BooleanOperation.Type = GeometricUtilities.BooleanOperation.BooleanType.Create
Dim section2 As Section
section2 = workPart.Sections.CreateSection(0.02413, 0.0254, 0.5)
extrudeBuilder1.Section = section2
Dim features2(0) As Features.Feature
Dim sketchFeature2 As Features.SketchFeature = Circle_sketch.Feature
features2(0) = sketchFeature2
Dim curveFeatureRule2 As CurveFeatureRule
curveFeatureRule2 = workPart.ScRuleFactory.CreateRuleCurveFeature(features2)
Dim rules2(0) As SelectionIntentRule
rules2(0) = curveFeatureRule2
Dim sketch2 As Sketch = Circle_sketch
Dim helpPoint2 As Point3d = New Point3d(0, 0, 0)
section2.AddToSection(rules2, Circle_sketch.GetAllGeometry(0), nullNXObject, nullNXObject, helpPoint2, Section.Mode.Create, False)
Dim direction2 As Direction
direction2 = workPart.Directions.CreateDirection(sketch2, Sense.Forward, SmartObject.UpdateOption.WithinModeling)
extrudeBuilder1.Direction = direction2
Dim ExtrudeFeature As Features.Feature
ExtrudeFeature = extrudeBuilder1.CommitFeature()
ExtrudeFeature.SetName("Circle")
extrudeBuilder1.Destroy()
extrudeBuilder1 = workPart.Features.CreateExtrudeBuilder(nullFeatures_Feature)
extrudeBuilder1.Limits.StartExtend.Value.RightHandSide = "0"
extrudeBuilder1.Limits.EndExtend.Value.RightHandSide = "5"
Dim CircleBody As Features.BodyFeature = ExtrudeFeature
Dim body1() As Body = CircleBody.GetBodies()
targetBodies1(0) = body1(0)
extrudeBuilder1.BooleanOperation.SetTargetBodies(targetBodies1)
extrudeBuilder1.BooleanOperation.Type = GeometricUtilities.BooleanOperation.BooleanType.Create
section2 = workPart.Sections.CreateSection(0.02413, 0.0254, 0.5)
extrudeBuilder1.Section = section2
sketchFeature2 = Cut_sketch.Feature
features2(0) = sketchFeature2
curveFeatureRule2 = workPart.ScRuleFactory.CreateRuleCurveFeature(features2)
rules2(0) = curveFeatureRule2
sketch2 = Cut_sketch
section2.AddToSection(rules2, Circle_sketch.GetAllGeometry(0), nullNXObject, nullNXObject, helpPoint2, Section.Mode.Create, False)
direction2 = workPart.Directions.CreateDirection(sketch2, Sense.Forward, SmartObject.UpdateOption.WithinModeling)
extrudeBuilder1.Direction = direction2
Dim CutFeature As Features.Feature
CutFeature = extrudeBuilder1.CommitFeature()
CutFeature.SetName("Cut")
extrudeBuilder1.Destroy()
Dim geomcopyBuilder1 As Features.GeomcopyBuilder
geomcopyBuilder1 = workPart.Features.CreateGeomcopyBuilder(nullFeatures_Feature)
geomcopyBuilder1.Type = Features.GeomcopyBuilder.TransformTypes.Rotation
geomcopyBuilder1.RotateDistance.RightHandSide = 0
geomcopyBuilder1.RotateAngle.RightHandSide = 360 / Z
geomcopyBuilder1.NumberOfCopies.RightHandSide = Z
Dim datumAxis1 As DatumAxis = CType(workPart.Datums.FindObject("DATUM_CSYS(0) Z axis"), DatumAxis)
Dim direction1 As Direction
direction1 = workPart.Directions.CreateDirection(datumAxis1, Sense.Forward, SmartObject.UpdateOption.WithinModeling)
Dim axis1 As Axis
axis1 = workPart.Axes.CreateAxis(nullPoint, direction1, SmartObject.UpdateOption.WithinModeling)
geomcopyBuilder1.RotationAxis = axis1
Dim CutBody As Features.BodyFeature = CutFeature
body1 = CutBody.GetBodies()
Dim added1 As Boolean
added1 = geomcopyBuilder1.GeometryToInstance.Add(body1(0))
Dim GeomCopyFeature As Features.Feature
GeomCopyFeature = geomcopyBuilder1.CommitFeature()
Dim nullFeatures_BooleanFeature As Features.BooleanFeature = Nothing
Dim booleanBuilder1 As Features.BooleanBuilder
booleanBuilder1 = workPart.Features.CreateBooleanBuilderUsingCollector(nullFeatures_BooleanFeature)
booleanBuilder1.Operation = Features.Feature.BooleanType.Subtract
body1 = CircleBody.GetBodies()
Dim added2 As Boolean
added2 = booleanBuilder1.Targets.Add(body1(0))
Dim features1(0) As Features.Feature
Dim geomcopy1 As Features.Geomcopy = GeomCopyFeature
features1(0) = geomcopy1
Dim bodyFeatureRule1 As BodyFeatureRule
bodyFeatureRule1 = workPart.ScRuleFactory.CreateRuleBodyFeature(features1)
Dim rules4(0) As SelectionIntentRule
rules4(0) = bodyFeatureRule1
Dim scCollector2 As ScCollector
scCollector2 = workPart.ScCollectors.CreateCollector()
scCollector2.ReplaceRules(rules4, False)
booleanBuilder1.ToolBodyCollector = scCollector2
Dim nXObject1 As NXObject
nXObject1 = booleanBuilder1.Commit()
booleanBuilder1.Destroy()
Dim objects2(0) As DisplayableObject
objects2(0) = CutBody.GetBodies(0)
theSession.DisplayManager.BlankObjects(objects2)
Catch ex As Exception
errorCode = 1
theUI.NXMessageBox.Show("Block Styler", NXMessageBox.DialogType.Error, ex.ToString)
End Try
CreateChainGear = errorCode
End Function
End Class
页:
[1]