三维建模VB程序.docx

1、三维建模VB程序三维建模VB程序Public I As Single Public i0 As Single Public i1 As Single Public i2 As Single Public i3 As Single Public h As Single Public b As Single Public r As Single Public r0 As Single Pub1ic rr As Single Public w As Single Public d As Single Public d0 As Single Public dl As Single Public l A

2、s Single Public al As SinglePublic e As Single Public intStru As Integer 选择哪种凸轮机构形式 Public intCreate As Integer 选择哪种轮廓生成模式 Public intUPFunc As Integer 选择哪种升程 Public intDownFunc As Integer 选择哪种回程 Public Const Pi As Single = Public strStruFunc() As String 机构形式公式 Public objEXP As New ClsFunExp 公式对象 Pub

3、lic sngS(359) As Single 距离 Public sngV(359) As Single 速度 Public sngA(359) As Single 加速度 Public sngPreDat() As Single 批量计算得到的结果 Public sngXY() As Single 坐标Public sngPoint() As Single 离散点Public Sub Init() 初始化,数组及公式 Erase sngS Erase sngV Erase sngA ReDim sngXY(359，l) 默认为360个点 ReDim strStruFunc(3，l) 机构形

4、式公式偏置尖顶直动从动件strstruFunc(0，0)=”e*Cos(i*pi/180)+(Sqr(r*r-e*e)+s)*Sin(i*pi/180)”strstruFunc(0，1)=”-e*Sin(i*pi/180)+(Sqr(r*r-e*e)+s)*Cos(i*pi/180)”偏置滚子直动从动件对心平底直动从动件摆动滚子从动件对心平底直动从动件摆动滚子从动件EndSub升程等速运动规律Public Functtion Nomal_UP_EQ(ByVal w As Single,ByVal h As Single, ByVal i0 As Single ) As Boolean Dim

5、i As Integer Dim i As Integert=Int(i0) On Error Resume NextFor i= 0 To tsngS(i)=i*h/10sngV(i)=w*h/10sngA(i)=0 If Err ThensngS(i)=0sngV(i)=0 End IfNextIf Err ThenNomal_UP_EQ =FalseElseNormal_UP_EQ=TrueEnd IfEnd Function升程等加速等减速运动规律升程余弦加速运动规律升程正弦加速运动规律远休程Public Function Far_NoMove (ByVal h As Single,B

6、yVal i0 As Single, ByVal i1 As Single ) As Boolean Dim i As Integer Dim t As Integert=Int(i0+i1)For i=Int(i0) To tsngS(i)=hNextEnd Function回程等速运动规律回程等加速等减速运动规律回程余弦加速运动规律回程正弦加速运动规律近休程Public Function Near_NoMove(ByVal h As Single,ByVal i0 As Single, ByVal i1 As Single,ByVal i2 As Single ) As Boolean D

7、im I As Integer Dim t As Integert=Int(i0+i1+i2)-lFor i=t To 359sngS(i)=0NextIf Err Then Near_NoMove=FalseElse Near_NoMove=True End IfEnd Function公式化输入 升程Public Function Custom_Up(ByVal strFunc As String, ByVal w As Single， ByVal h As Single, ByVal i0 As Single ) As BooleanDim objTExp As New ClsFunEx

8、p=strFuncIf Not ThenCustom_Up=False Exit Function End If Dim strKey As String 检查变量是否正确strKey=”i，h，i0” If 3 ThenCustom_Up=False Exit Function End If”h”, h”10”,i0 Dim i As IntegerDim t As Integert=Int(i0) on Error Resume NextFor i=0 To t”i”,isngS(i)=(0)sngV(i)=0sngA(i)=0 If Err ThensngS(i)=0sngV(i)=0s

9、ngA(i)=0 End IfNextIf Err ThenCustom_Up=FalseElseCustom_Up=TrueEnd IfEnd Function公式化输入 回程只允许输入数字，使用时放在keypress事件中 And InStr,”.”)= 0 ThenElseiValue=0 End If EndIfEndIfFilterNumber=iValueEnd Function将所有数据显示到列表中Public Function LvAddLine( ByRef objList As ListView,ByVal intI As Integer， ByVal S As Singl

10、e, ByVal v As Single,ByVal A As Single ,ByVal X As Single,ByVal Y As Single) As BooleanDim i As Integer Dim objItem As ListItemi= On Error Resume Next Set objItem=&i,CStr(intI)(1)=CStr(S)(2)=CStr(v)(3)=CStr(A)(4)=CStr(X)(5)=CStr(Y) If Err ThenLvAddLine=FalseElseLvAddLine=True End If End Function添加离散

11、点到ListView列表中 Public Function PointList_Add(ByRef objList As ListView, ByVal sngX As Single，ByVal sngS As Single) As Boolean Dim i As Integer Dim iCount As Integer Dim objItem As ListItem On Error Resume Next判断数据不重复，重复则修改原数据 For i=1 To If (i).Text = CStr(sngX) Then(i).SubItems(1)=CStr(sngS) PointLis

12、t_Add=True Exit Function End IfNext在这里要寻找合适的点I= objItem=&i,CStr(sngX)(1)=CStr(sngS)If Err Then PointList_Add=Fa1seEisePointList_Add=TrueEnd IfEnd Function读离散点数据到数组Public Function PointList2Arr (ByRef objUpList As ListView, objDownList As ListView) As BooleanDim i As Integer Dim iCount Up As Integer

13、Dim iCountDown As Integer Dim intX As Integer读取数据 Erase sngPoint()iCountUP= If iCountUp + iCountDown=0 thenPointList2Arr= False Exit FunctionEnd If定义大小，加上远休和近休 ReDim sngPoint ( iCountUp + CountDown + i1+i3-l, l )添加升程数据intX=0 For i=1 To iCountUp sngPoint(i-1,0)=CSng ( (i).Text)sngPoint(i-1,1)=CSng (

14、(i).SubItems(1)/1000Next远休int X = iCountUpFor i = To i1 -1sngPoint(i+iCountUp,0)= i +i0sngPoint(i+iCountUp,I) = hNext添加回程数据For i=1 To iCountDownsngPoint (i+iCountUp+i1-1,0)=CSng(i).Text)+i0+i1sngPoint(i+iCountUp+i1-1, 1)=CSng(i)=Subltems(1)/1000 Next 近休数据 For i = 0 To i3-1 sngPoint(i+iCountUp+i1+iCo

15、untDown,0)=I + i0 + i1 + i2sngPoint(i+iCountUp+i1+iCountDown,1)=0Next If Err ThenPointList2Arr=FalseElsePointList2Arr=True End IfEnd Function机构形式公式计算 Public Function StructComputer(ByVal intStru As Integer) As Boolean Dim i As Integer Dim objFuncX As ClsFunExp Dim objFuncY As ClsFunExp Dim intPointC

16、ount As Integer 离散点个数根据选择创建坐标 Select Case intCreateCase 0,2 公式计算，360个点 ReDim sngXY(359，1)Case l 离散点intPointCount=UBound(sngPoint)离散点数据出错 If Err ThenStructComPuter=False Exit Function End If ReDim sngXY(intPointCount,1) End Select套用X坐标公式进行计算 Set objFuncX=New ClsFunExp=strStruFunc(intStru,0)解析数据 If No

17、t ThenStructComPuter=False Exit Function End If套用Y坐标公式进行计算 Set objFuncY=New ClsFunExp=strStruFunc(intStru,1)解析 If Not ThenStructComPuter=False Exit Function End If代入各机构机构模型所需的参数”e”,e”r”, r Dim u As Single Dim uu As Single Select Case intCreate 计算值Case 0,2 常用规律和公式For i= 0 To 359 计算”v”,sngV(i)”s”,sngS

18、(i)”a”,sngA(i)sngXY(i,0)= (CSng(i),”i”)”i”,i”s”,sngS(i)”v”,sngV(i)”a”,sngA(i)sngXY(i，1)=(CSng(i)，”I”)NextCase l 离散点输入 For i=0 To intPointCount”I”,sngPoint(i,0)”s”,sngPoint(i,1)sngXY(i,0)=(0)”i”,sngPoint(i,0)”s”,sngPoint(i,l)sngXY(i,l)=(0)Next End Select If Err Then StructComputer=FalseElseStructComP

19、uter=TrueEnd IfEnd Function根据生成的sngxY()坐标，输出到SW系统中传递的参数必须是XY(n,l)二维数组Public Function ModelOut(iXY() As Single) As Boolean Dim i As Integer Dim i Count Dim swApp As Object Dim Part As Object Dim SelMgr As Object Dim boolstatus As Boolean Dim longstatus As Long, longwarnings As Long Dim Feature As Obj

20、ect Dim Annotation As Object On Error Resume Next If UBound(iXY,2)1 Then 判断数据大小是否正确ModelOut=False Exit Function End If If Err ThenModelOut=False Exit Function End IfiCount=UBound(iXY,l) 计算点的个数Set swApp = 创建Sw对象If Err ThenMsgBox”无法创建Sldworks对象!”,vbOKOnly + vbInformationModelOut = False Exit Function

21、End If = True Set Part=(“D:Solidworks 2006langchinese-simplifiedTutorial”,0,0#,0#) If Err ThenMsgBox”无法打开Part文档!”,vbOKOnly+vbInformationModelOut=False Exit Function End Ifboolstatus=前视”,”PLANE”,0,0,0,Fa1se，0,Nothing,0),0,0,0,r0,0 画基圆 For i=0 To iCount 把点云转化为曲线Part SketchSpline iCount+1-I,iXY(I,0),iX

22、Y(i,1),0Next i 0, iXY(0,0),iXY(0,1),0 True TrueBoolstatus=样条曲线1草图1”,“EXTSKETCHSEGMENT”,0,0,0,False,0,Nothing,0) “*上下二等角轴测”,s TrueBoolstatus=样条曲线l草图1”,“EXTSKETCHSEGMENT”,0,0,0,False,0,Nothing,0) True,False,False,6,0,d,False,False,False,False,0,0,False,False,False,False,l,1,1,0,0,False If Err ThenModelOut=FalseElseModelOut=True End IfEnd Function