|
这是一个VB与CAD二次开发的程序，是关于直齿齿轮切齿的程序，程序如下： Option Explicit
Dim 齿轮CAD As acadapplication
Private Sub form_load()
Me.Caption = "齿轮加工三维动画仿真"
Me.Left = (Screen.Width - Me.Width)
Me.Top = 0
Me.label1 = "齿数"
Me.label2 = "模数"
Me.label3 = "压力角"
Me.commandl.Caption = "确定"
Me.Command2.Caption = "取消"
Me.Text1 = 18
Me.Text2 = 5
Me.Text3 = 20
On Error Resume Next
Set 齿轮CAD = GetObject(, "AutoCAD,application")
If Err Then
Err.Clear
Set 齿轮CAD = CreateObject("autocad.application")
If Err Then
MsgBox ("请先安装autocad2007")
Unload Me
Exit Sub
End If
End If
齿轮CAD.WindowState = acmax
End Sub
Private Sub commandl_click()
On Error Resume Next
齿轮CAD.activedocument.Close
齿轮CAD.documents.Add
Dim CZ, CM, CA, CR, CRb, CRa, CR, f, CSb, Umax, U, B
Dim Th(3)
Dim I
CZ = Me.Text1
CM = Me.Text2
CA = Me.Text3 * 3.141 / 180
Dim newdirection(0 To 2) As Double
newdirection(0) = 1: newdirection(1) = 0.5: newdirection(2) = 0.5
齿轮CAD.activedocument.activeviewport.direction = newdirection
齿轮CAD.activedocument.activeewport = _
齿轮CAD.activedocument.layers(0).Color = acred
齿轮CAD.activedocument.sendcommand "_shademode" + vbCr + "_g" + vbCr
CR = CM * CZ / 2
CRf = (CR - 1.25 * CM)
CRb = CR * Cos(CA)
CRa = CR + CM
Dim 齿轮3d As acad3dsolid
Dim centerpoint(0 To 2) As Double
centerpoint(0) = 0#: centerpoint(1) = 0#: centerpoint(2) = 0#
Dim height As Double
height = CRa / 3 / 3
Set 齿轮3d = 齿轮CAD.activedocument.modeispace.addcylinder_(centerpoiny, CRa / 3, height)
齿轮3d.Boolean acsubtraction, 轴孔
齿轮3d.Color = acblue
zoomall
Dim plineobj(0) As acadlwpolyline
CSb = Cos(CA) * (3.14 * CM / 2 + CM * CZ * (Tan(CA - (CA))))
Th(1) = (3.14 * CM * Cos(CA) - CSb) / (2 * CRb)
Th(0) = Th(1) / 3
Th(2) = Th(1) + Tan(CA) - CA Th(3) = Th(1) + Tan(Acos(CRb / CRa)) - Acos(CRb / CRa)
Dim curves(0 To 5) As acadentily
Dim points0(0 To 5) As Double
Dim points1(0 To 8) As Double
Dim points2(0 To 5) As Double
points0(0) = 0: points0(1) = CRf
points0(2) = CRf * Sin(Th(0)): points0(3) = CRf * Cos(Th(0))
points0(4) = CRb * Sin(Th(1)): points0(5) = CRb * Cos(Th(1))
Dim startTan(0 To 2) As Double
Dim endtan(0 To 2) As Double
start Tan(0) = 0: startTan(1) = 0: startTan(2) = 0
endtan(0) = 0.5: endtan(1) = 0.5: endtan(2) = 0
points1(0) = points0(4): points1(1) = points0(5): points1(2) = 0
points1(3) = CR * Sin(Th(2)): points1(4) = CR * Cos(Th(2)): points1(5) = 0
points1(6) = CRa * Sin(Th(3)): points1(7) = CRa * Cos(Th(3)): points1(8) = 0
points2(0) = points1(6): points2(1) = points1(7)
points2(2) = points1(6): points2(3) = points1(7) + 2.25 * CM
points2(4) = 0: points2(5) = points2(3)
If CRb < CRf Then
points0(2) = points1(3) * 0.2: points0(3) = points0(1) + 0.25 * CM * 0.03
points0(4) = points1(3) * 0.7: points0(5) = points0(1) + 0.25 * CM * 0.8
points1(0) = points0(4): points1(1) = points0(5): points1(2) = 0
End If
Set curves(0) = 齿轮CAD.activedoument.modelspace.addlightweightpolyline(points0)
curves(0).sotbulge1 , 0.2
Set curves(1) = 齿轮CAD.activedocument.modelspace.addspline(points1, startTan, endtan)
Set curves(2) = 齿轮CAD.activedocumentmodelspace.addlightweighpolyline(points2)
Dim point1(0 To 2) As Double
Dim point2(0 To 2) As Double
point1(0) = 0: point1(1) = 0: point1(2) = 0
point2(0) = 0: point2(1) = 1: point2(2) = 0
Set curves(3) = curves(2).mirror(point1, point2)
Set curves(4) = curves(1).mirror(point1, point2)
Set curves(5) = curves(0).mirror(point1, point2)
Dim 刀具 As Variant
刀具 = 齿轮CAD.activedocument.modelspace.addregion(curves)
Dim axispt(0 To 2) As Double
Dim axisdir(0 To 2) As Double
Dim angle As Double
axispt(0) = 0: axispt(1) = points2(5) + 2 * CM: axispt(2) = 0
axisdir(0) = 1: axisdir(1) = 0: axisdir(2) = 0
angle = 6.29
Dim 刀具3d As acad3dsolid
Set 刀具3d = 齿轮CAD.activedocument.modelspace.addrevolvedsolid(刀具(0), axispt, axisdir, angle)
zoomall
Dim boxobj As acad3dsolid
Dim center(0 To 2) As Double
Dim taperangle As Double
taperangle = 0
center(0) = 0: center(1) = CRf: center(2) = 0
Set boxobj = 齿轮CAD.activedocument.modelspace.addbox(center, CM / 2, 4 * CM, pints(0) * 2)
Dim retobj As Variant
retobj = boxobj.arraypolar(20, 6.28, 刀具3d.centroid)
For I = 0 To 20 - 2
retobj(I).rotate3dcenter , centerpoint, 3.14 / 2
retobj(I).Update
刀具3d.Boolean acsubtraction, retobj(I)
Next I
Dim 刀具bool As acad3dsolid
Set 刀具bool = 齿轮CAD.activedocument.modelspaceaddextrudedsolid(刀具(0), height, taperangle)
axispt(0) = 刀具bool.centroid(0)
axispt(1) = 刀具bool.centroid(1)
axispt(2) = 0
刀具bool.move刀具bool.centroid , axispt
刀具bool.Move.Visible = False
axispt(0) = 刀具3d.centroid(0) + 10
axispt(1) = 刀具3d.centroid(1)
axispt(2) = 刀具3d.centroid(2)
point1(0) = 刀具3d.centroid(0)
point1(1) = 刀具3d.centroid(1)
point1(2) = 刀具3d.centroid(2) + height
刀具3d.move刀具3d.centroid , point1
Dim entry As acadentity
For Each entry In 齿轮CAD.activedocument.modelspace
If entry.objectID <> 齿轮3d.objectID And entry.objectID <> 刀具3d.objectID And entry.objectID <> 刀具bool.objectID Then entry.Delete
End If
Next
Dim 刀具复制 As acad3dsolid
Dim k
I = 0
Dim 刀具3dz坐标 As Double
刀具3dz坐标 = 刀具3d.centroid(2)
Do Until I > 360
For k = 刀具3dz坐标 To 刀具3dz坐标 - height Step -height / 3
point1(2) = k
刀具3d.move刀具3d.centroid , point1
刀具3d.Update
axispt(2) = 刀具3d.centroid(2)
刀具3d.rotate3d刀具3d.centroid , axispt, 360 / 30 * 3.141 / 180
刀具3d.Update
Next k
Set 刀具复制 = 刀具bool.Copy
齿轮3d.Boolean acsubtraction, 刀具复制
齿轮3d.Update
point1(2) = point1(2) + height
刀具3d.move刀具3d.centroid , point1
刀具3d.Update
齿轮3d.rotate centerpoint, -360 / CZ * 3.141 / 180
齿轮3d.Color = acblue
齿轮3d.Update
I = 360 / CZ + I
Loop End Sub Private Sub command2_click()
Me.Text1 = 18
Me.Text2 = 5
Me.Text3 = 20
End Sub 公共模块代码
option explicit
public function Acos(x)
dim sinx,cosx,tanx
if x=0 then Acos=3.14159/2#
if x>0 then
sinx=sqr(1#-x^2)
cosx=x
tanx=sinx/cosx
Acos=Atn(tanx)
if x<0 then
sinx=-sqr(1#-x^2)
cosx=x
tanx=sinx/cosx
Acos=Atn(tanx)+3.14159
end if
end function
但调试时出现：未找到方法或数据成员，这是怎么回事？ | 
发表于 2010-2-25 20:06:00
置顶卡
变色卡
显身卡