二维齿轮怎样生成三维的,我还想镜象下,生成啮合齿轮,

tangting0439 · 发表于 2009-5-16 14:22:59

马上注册，结识高手，享用更多资源，轻松玩转三维网社区。

您需要登录才可以下载或查看，没有帐号？注册

x

Private Sub CommandButton1_Click()
   mNumber = Val(UserForm1.TextBox1.Text)
   zNumber = Val(UserForm1.TextBox2.Text)
   aAngle = Val(UserForm1.ComboBox1.Text)
   ha = Val(UserForm1.ComboBox2.Text)
   c = Val(UserForm1.ComboBox3.Text)
   Unload Me

   If mNumber = 0 Or zNumber = 0 Then
      Exit Sub

End If
   aAngle = aAngle * 3.1415926 / 180





Dim bAngle As Double
Dim X1 As Variant, X2 As Variant
Dim Y1 As Variant, Y2 As Variant

bAngle = 3.1415926 / (2 * zNumber)

X1 = -(mNumber * zNumber * Sin(bAngle)) / 2
Y1 = (mNumber * zNumber * Cos(bAngle)) / 2

X2 = (mNumber * zNumber * Sin(bAngle)) / 2
Y2 = Y1

Dim bbAngle As Double
Dim inv_a As Double

Dim Xb1 As Variant, Yb1 As Variant
Dim Xb2 As Variant, Yb2 As Variant

inv_a = Tan(aAngle) - aAngle
bbAngle = 3.1415926 / (2 * zNumber) + inv_a

Xb1 = -((mNumber * zNumber * Cos(aAngle) * Sin(bbAngle)) / 2)
Yb1 = (mNumber * zNumber * Cos(aAngle) * Cos(bbAngle)) / 2

Xb2 = (mNumber * zNumber * Cos(aAngle) * Sin(bbAngle)) / 2
Yb2 = Yb1

Dim aaAngle As Double
Dim baAngle As Double
Dim inv_aa As Double

Dim Xa1 As Variant, Ya1 As Variant
Dim Xa2 As Variant, Ya2 As Variant
Dim a1 As Double

a1 = (((zNumber + 2 * ha) ^ 2) / (zNumber * Cos(aAngle)) ^ 2) - 1
inv_aa = Sqr(a1)
aaAngle = Atn(Sqr(a1))
inv_aa = inv_aa - aaAngle
baAngle = 3.1415926 / (2 * zNumber) - (inv_aa - inv_a)

Xa1 = -(zNumber + 2 * ha) * mNumber * Sin(baAngle) / 2
Ya1 = (zNumber + 2 * ha) * mNumber * Cos(baAngle) / 2

Xa2 = (zNumber + 2 * ha) * mNumber * Sin(baAngle) / 2
Ya2 = Ya1

Dim Xaz As Variant, Yaz As Variant

Xaz = 0: Yaz = (zNumber + 2 * ha) * mNumber / 2

Dim blockObj As AcadBlock
Dim insPnt(0 To 2) As Double
Dim allEnt As AcadEntity
Dim blkRef As AcadBlockReference
Dim blkCount As Integer
Dim blkName As String

For Each allEnt In ThisDrawing.ModelSpace
   If StrComp(allEnt.EntityName, "AcDbBlockReference", 1) = 0 Then
         Set blkRef = allEnt
         If StrComp(Left(blkRef.Name, 7), "blkGEAR", 1) = 0 Then
            blkCount = blkCount + 1
      End If
   End If
Next
blkCount = blkCount + 1

insPnt(0) = 0: insPnt(1) = 0: insPnt(2) = 0
blkName = "blkGEAR" & blkCount
Set blockObj = ThisDrawing.Blocks.Add(insPnt, blkName)

Dim sTan(0 To 2) As Double
Dim eTan(0 To 2) As Double
Dim fitPnts(0 To 8) As Double
Dim splineL As AcadSpline
Dim splineR As AcadSpline

sTan(0) = 0: sTan(1) = 0: sTan(2) = 0
eTan(0) = 0: eTan(1) = 0: eTan(2) = 0
fitPnts(0) = Xb1: fitPnts(1) = Yb1: fitPnts(2) = 0
fitPnts(3) = X1: fitPnts(4) = Y1: fitPnts(5) = 0
fitPnts(6) = Xa1: fitPnts(7) = Ya1: fitPnts(8) = 0

Set splineL = blockObj.AddSpline(fitPnts, sTan, eTan)

fitPnts(0) = Xb2: fitPnts(1) = Yb2: fitPnts(2) = 0
fitPnts(3) = X2: fitPnts(4) = Y2: fitPnts(5) = 0
fitPnts(6) = Xa2: fitPnts(7) = Ya2: fitPnts(8) = 0

Set splineR = blockObj.AddSpline(fitPnts, sTan, eTan)

Dim Ra As Double
Dim sAng As Double, eAng As Double
Dim arcObj As AcadArc

Ra = (zNumber + 2 * ha) * mNumber / 2
sAng = 3.1415926 / 2 - baAngle
eAng = 3.1415926 / 2 + baAngle

Set arcObj = blockObj.AddArc(insPnt, Ra, sAng, eAng)

Dim zAngle As Double
Dim aveAng As Double
Dim Rf As Double
Dim gd_X1 As Double, gd_Y1 As Double
Dim poly_arc As AcadLWPolyline
Dim points(0 To 3) As Double

zAngle = (360 / zNumber / 2) * (3.1415926 / 180)

aveAng = (bbAngle + zAngle) / 2

Rf = (zNumber - 2 * ha - 2 * c) * mNumber / 2

gd_X1 = Rf * Sin(aveAng)
gd_Y1 = Rf * Cos(aveAng)

points(0) = Xb2: points(1) = Yb2
points(2) = gd_X1: points(3) = gd_Y1

Set poly_arc = blockObj.AddLightWeightPolyline(points)

poly_arc.SetBulge 0, 0.2
poly_arc.Update

Dim arcfObj As AcadArc

sAng = 3.1415926 / 2 - zAngle
eAng = 3.1415926 / 2 - aveAng

Set arcfObj = blockObj.AddArc(insPnt, Rf, sAng, eAng)

Dim mirPnt1(0 To 2) As Double
Dim mirPnt2(0 To 2) As Double
Dim poly_arc1 As AcadLWPolyline
Dim arcfObj1 As AcadArc

mirPnt1(0) = Xaz: mirPnt1(1) = Yaz: mirPnt1(2) = 0
mirPnt2(0) = 0: mirPnt2(1) = 0: mirPnt2(2) = 0

Set poly_arc1 = poly_arc.Mirror(mirPnt1, mirPnt2)

Set arcfObj1 = arcfObj.Mirror(mirPnt1, mirPnt2)

Dim blkRefObj As AcadBlockReference
Dim insertPnt As Variant
Dim rotangle As Double
Dim I As Integer

insertPnt = ThisDrawing.Utility.GetPoint(, "选择插入点:")

xscale = 1: yscale = 1

On Error Resume Next

xscale = ThisDrawing.Utility.GetReal("选择X轴比例因子(默认为1):")

yscale = ThisDrawing.Utility.GetReal("选择Y轴比例因子(默认为1):")

For I = 0 To zNumber - 1

      rotangle = I * (360 / zNumber) * 3.1415926 / 180
      Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertPnt, blkName, xscale, yscale, 1#, rotangle)


Next

ThisDrawing.Regen acActiveViewport

End Sub

Private Sub CommandButton2_Click()

   Unload Me
End Sub

Private Sub UserForm_Initialize()
'默认时的参数值
   mNumber = 0
   zNumber = 0
   aAngle = 20
   ha = 1
   c = 0.25


   '添加压力角组合框的值

UserForm1.ComboBox1.AddItem "20"
UserForm1.ComboBox1.AddItem "15"

   '添加顶高系数组合框的值

UserForm1.ComboBox2.AddItem "1.0"
UserForm1.ComboBox2.AddItem "0.8"

   '添加顶隙系数组合框的值

UserForm1.ComboBox3.AddItem "0.25"
UserForm1.ComboBox3.AddItem "0.3"

      '设定组合框初始状态显示的值
UserForm1.ComboBox1.Text = "20"
UserForm1.ComboBox2.Text = "1.0"
UserForm1.ComboBox3.Text = "0.25"

UserForm1.TextBox1.SetFocus

End Sub

		自动登录	找回密码
密码			注册

通知

[求助] 二维齿轮怎样生成三维的,我还想镜象下,生成啮合齿轮,

马上注册，结识高手，享用更多资源，轻松玩转三维网社区。

浏览过的版块