急！有偿！[求助]

liuyuabc 发表于 2004-6-2 23:27:00

轴和轴承的ＶＢ三维造型程序！ＣＡＤ的二次开发！后天要交！

雪山飞狐_lzh 发表于 2004-6-3 15:21:00

这个，最好你自己先编一个原型，看看有什么不懂再。。。

liuyuabc 发表于 2004-6-3 21:34:00

Dim DaoJu As Variant Dim D0, D1, D2, D3, D4, D5, n1, r1, r2, l0, l1, l2, l3, l4, l5 As Double '轴结构参数 Const Pi = 3.141592 '圆周率 Dim AcadApp As AcadApplication

Sub ConnectCAD() On Error Resume Next Err.Clear Set AcadApp = GetObject(, "AutoCAD.Application") If Err.Number Then ' MsgBox Err.Description Err.Clear Set AcadApp = CreateObject("AutoCAD.Application") If Err.Number Then MsgBox Err.Description Exit Sub End If End If AcadApp.Visible = True AcadApp.WindowState = AutoCAD.AcWindowState.acMax AppActivate (AcadApp.Caption) End Sub Private Sub Command1_Click() Call ConnectCAD

'遍历模型空间的所有成员，删除一切实体 Dim Entry As AutoCAD.AcadEntity For Each Entry In AcadApp.ActiveDocument.ModelSpace Entry.Delete Next

'设置三维视点 Dim NewDirection(2) As Double NewDirection(0) = 1: NewDirection(1) = 0.5: NewDirection(2) = 0.5 AcadApp.ActiveDocument.ActiveViewport.Direction = NewDirection AcadApp.ActiveDocument.Layers.Item(0).Color = AutoCAD.AcColor.acRed '层0设为红色

AcadApp.ActiveDocument.SendCommand ("_Shademode" + vbCr + "_G" + vbCr) '着色

'轴输入参数 D2 = Val(Me.Text1.Text) l2 = Val(Me.Text2.Text) '轴毛坯参数 D0 = D2 - 15 D1 = D2 - 5 D3 = D2 + 12 D4 = D3 - 5 D5 = D1 n1 = 2 r1 = 1.6 r2 = 2 Dim plineObj(1) As AutoCAD.AcadLWPolyline Dim points(31) As Double points(0) = 0: points(1) = 6 '1点的X，Y坐标 points(2) = D0 / 2 - n1: points(3) = 0 '2点 points(4) = points(2) + n1: points(5) = n1 '3点 points(6) = points(4): points(7) = l0 - r1 '4点 points(8) = D1 / 2: points(9) = points(7) + r1 '5点 points(10) = points(8): points(11) = l0 + l1 - r2 '6点 points(12) = D1 / 2: points(13) = points(11) + r2 '7点 points(14) = points(12): points(15) = points(13) + l2 - r2 '8点 points(16) = D3 / 2: points(17) = points(15) + r2 '9点 points(18) = points(16): points(19) = points(17) + l3 '10点 points(20) = D4 / 2: points(21) = points(19) + r2 '11点 points(22) = points(20): points(23) = points(21) + l4 '12点 points(24) = D5 / 2: points(25) = points(23) + r2 '13点 points(26) = points(24): points(27) = points(25) + l5 - n1 '14点 points(28) = points(26) - n1: points(29) = points(27) + n1 '15点 points(30) = 0: points(31) = points(29) '16点

'points(32) = points(16): points(33) = points(17) + l3 '17点 'points(34) = points(16): points(35) = points(17) + l3 '18点 'points(36) = points(16): points(37) = points(17) + l3 '19点 'points(38) = points(16): points(39) = points(17) + l3 '20点 'points(40) = points(16): points(41) = points(17) + l3 '21点 'points(42) = points(16): points(43) = points(17) + l3 '22点 Set plineObj(0) = AcadApp.ActiveDocument.ModelSpace.AddLightWeightPolyline(points) plineObj(0).Closed = True

'镜象1－10点围成的图形 Dim point1(2) As Double Dim point2(2) As Double point1(0) = 0: point1(1) = 0: point1(2) = 0 point2(0) = 0: point2(1) = 1: point2(2) = 0

Set plineObj(1) = plineObj(0).Mirror(point1, point2) '创建为面域 Dim regionObj As Variant regionObj = AcadApp.ActiveDocument.ModelSpace.AddRegion(plineObj)

'布尔加运算 regionObj(0).Boolean AutoCAD.AcBooleanType.acUnion, regionObj(1) '旋转面域 Dim axisPt(2) As Double Dim axisDir(2) As Double Dim angle As Double axisPt(0) = 0: axisPt(1) = 0: axisPt(2) = 0 axisDir(0) = 1: axisDir(1) = 0: axisDir(2) = 0 angle = 2 * Pi Dim solidObj As AutoCAD.Acad3DSolid Set solidObj = AcadApp.ActiveDocument.ModelSpace.AddRevolvedSolid(regionObj(0), axisPt, axisDir, angle)

AcadApp.ZoomExtents

'沿Y轴旋转90度 Dim rotatePt1(2) As Double Dim rotatePt2(2) As Double Dim rotateAngle As Double

rotatePt1(0) = 0: rotatePt1(1) = 0: rotatePt1(2) = 0 rotatePt2(0) = 0: rotatePt2(1) = 1: rotatePt2(2) = 0 rotateAngle = 90 rotateAngle = rotateAngle * Pi / 180#

solidObj.Rotate3D rotatePt1, rotatePt2, rotateAngle '键 Dim boxobj As AutoCAD.Acad3DSolid Dim length As Double, width As Double, height As Double Dim center(2) As Double

center(0) = 0: center(1) = -D4 / 2: center(2) = 0 length = D4 * 0.3: width = D4 * 0.3: height = B * 1.1

Set boxobj = AcadApp.ActiveDocument.ModelSpace.AddBox(center, length, width, height) solidObj.Boolean AutoCAD.AcBooleanType.acSubtraction, boxobj

Dim i As Integer End Sub Private Sub Command2_Click() Unload Me End Sub

Private Sub Form_Load() Me.Caption = "轴" Me.Label1.Caption = "D2" Me.Label2.Caption = "l2" 'Me.Label3.Caption = "压力角Af" 'Me.Label4.Caption = "轴径D4"

'赋初值 Me.Text1.Text = 75 'd2 Me.Text2.Text = 82 'l2

Me.Command1.Caption = "轴结构造型" Me.Command2.Caption = "结束"

End Sub

liuyuabc 发表于 2004-6-3 21:38:00

liuyuabc 发表于 2004-6-3 21:43:00

轴承的我不会呀！麻烦高手帮个忙！上面是轴和垫片的程序！轴的长度尺寸可以自己定！谢谢！

雪山飞狐_lzh 发表于 2004-6-4 13:02:00

轴和轴承有区别麽？应该原理差不多吧，既然轴都编出来了，轴承应该对你来说不难吧

页: [1]

明经CAD社区's Archiver

急！有偿！[求助]