functions.bas

CATIA二次开发

Attribute VB_Name = "functions"
Option Explicit
'*******************************************************************************
'   Purpose:      功能模块
'   Assumtions:
'   Author:       SUNNYTECH Huting
'   Languages:    VBScript
'   Locales:      Chinese
'   CATIA Level:  V5R7
' ***********************************************************************
  
  ' Pi定义
  ' -------------
    Const Pi = 3.14159265358979
    
  ' 凸轮轴数据
  ' -------------
    Public dCamSetDis As Double
    Public dBearingRadius As Double
    Public dCamThickness As Double
    Public dDriveWheelRadius As Double

  ' 凸轮轴方向
  ' -------------
    Dim oRefPlane As Reference

' **************************************************************************
' Purpose:   初始化全局变量
' **************************************************************************
Sub initVars()
    
'    dCamSetDis        = 100
'    dBearingRadius    = 20
'    dCamThickness     = 20
'    dDriveWheelRadius = 50
    
    dCamSetDis = Val(Form1.txtCamSetDis.Text)
    dBearingRadius = Val(Form1.txtBearingRadius.Text)
    dCamThickness = Val(Form1.txtCamThickness.Text)
    dDriveWheelRadius = Val(Form1.txtDriveWheelRadius.Text)
    
    Set oRefPlane = _
        oPart.CreateReferenceFromObject(oPart.OriginElements.PlaneYZ)

End Sub

' **************************************************************************
' Purpose:   创建凸轮连接轴
'
' Inputs :   dBearingLength: 凸轮连接轴长度
'            dRefDis:        凸轮连接轴起始位置
' **************************************************************************
Sub CreateBearing(dBearingLength As Double, dRefDis As Double)

  ' Create a sketch
  ' ---------------
    Dim oSketch  As Sketch
    Set oSketch = oBody.Sketches.Add(oRefPlane)

  ' Create base elements in the sketch
  ' ----------------------------------
    Dim oFactory2D As Factory2D
    Set oFactory2D = oSketch.OpenEdition

        Dim oCircle As Circle2D
        Set oCircle = oFactory2D.CreateClosedCircle(0, 0, dBearingRadius)
    
    oSketch.CloseEdition
    
    Dim oPadBearing As Pad
    Set oPadBearing = oSF.AddNewPad(oSketch, 100)
    
    oPadBearing.FirstLimit.Dimension.Value = dRefDis + dBearingLength
    oPadBearing.SecondLimit.Dimension.Value = dRefDis * -1

End Sub

' **************************************************************************
' Purpose:   创建不同角度的凸轮
'
' Inputs :   dAngle:   凸轮角度
'            dRefDis:  凸轮起始位置
' **************************************************************************
Sub CreateCam(dAngle As Double, dRefDis As Double)

  ' Create a sketch
  ' ---------------
    Dim oSketch  As Sketch
    Set oSketch = oBody.Sketches.Add(oRefPlane)

  ' Create base elements in the sketch
  ' ----------------------------------
    Dim oFactory2D As Factory2D
    Set oFactory2D = oSketch.OpenEdition
    
        Dim oLineH As Line2D, oPtO As Point2D
        Set oLineH = oSketch.AbsoluteAxis.HorizontalReference
        Set oPtO = oSketch.AbsoluteAxis.Origin
                
        Dim oLineConst As Line2D
        Set oLineConst = oFactory2D.CreateLine(0, 0, 50, 0)
        oLineConst.StartPoint = oPtO
        oLineConst.Construction = True
        
        '---------------------------------------------
        Dim oCircle1 As Circle2D, oCircle2 As Circle2D
        Set oCircle1 = oFactory2D.CreateCircle(0, 0, 30, Pi / 2, -Pi / 2)
        oCircle1.CenterPoint = oLineConst.StartPoint
        
        Set oCircle2 = oFactory2D.CreateCircle(50, 0, 15, -Pi / 2, Pi / 2)
        oCircle2.CenterPoint = oLineConst.EndPoint
        
        Dim oL1 As Line2D, oL2 As Line2D
        Set oL1 = oFactory2D.CreateLine(0, 30, 50, 15)
        Set oL2 = oFactory2D.CreateLine(0, -30, 50, -15)
        oL1.StartPoint = oCircle1.StartPoint
        oL2.StartPoint = oCircle1.EndPoint
        oL1.EndPoint = oCircle2.EndPoint
        oL2.EndPoint = oCircle2.StartPoint
        '---------------------------------------------
      
      ' Create constraints
      ' ------------------
        Dim oConstraints As Constraints, oConstraint As Constraint
        Set oConstraints = oSketch.Constraints
                
        '---------------------------------------------
        Dim oRefC1 As Reference, oRefC2 As Reference
        Set oRefC1 = oPart.CreateReferenceFromObject(oCircle1)
        Set oRefC2 = oPart.CreateReferenceFromObject(oCircle2)
        
        Dim oRefL1 As Reference, oRefL2 As Reference
        Set oRefL1 = oPart.CreateReferenceFromObject(oL1)
        Set oRefL2 = oPart.CreateReferenceFromObject(oL2)
        
        Set oConstraint = _
            oConstraints.AddBiEltCst(catCstTypeTangency, oRefL1, oRefC1)
        Set oConstraint = _
            oConstraints.AddBiEltCst(catCstTypeTangency, oRefL1, oRefC2)
        Set oConstraint = _
            oConstraints.AddBiEltCst(catCstTypeTangency, oRefL2, oRefC1)
        Set oConstraint = _
            oConstraints.AddBiEltCst(catCstTypeTangency, oRefL2, oRefC2)
        
        Set oConstraint = _
            oConstraints.AddMonoEltCst(catCstTypeRadius, oRefC1)
        oConstraint.Dimension.Value = 30
        
        Set oConstraint = _
            oConstraints.AddMonoEltCst(catCstTypeRadius, oRefC2)
        oConstraint.Dimension.Value = 15
        '---------------------------------------------
        
        Dim oRefLH As Reference, oRefLC As Reference
        Set oRefLC = oPart.CreateReferenceFromObject(oLineConst)
        Set oRefLH = oPart.CreateReferenceFromObject(oLineH)
        
        Set oConstraint = _
            oConstraints.AddMonoEltCst(catCstTypeLength, oRefLC)
        oConstraint.Dimension.Value = 50
        
        Set oConstraint = _
            oConstraints.AddBiEltCst(catCstTypeAngle, oRefLC, oRefLH)
        oConstraint.Dimension.Value = dAngle
        
    oSketch.CloseEdition
    
    Dim oPadCam As Pad
    Set oPadCam = oSF.AddNewPad(oSketch, 20)

    oPadCam.FirstLimit.Dimension.Value = dRefDis + dCamThickness
    oPadCam.SecondLimit.Dimension.Value = dRefDis * -1

End Sub

' **************************************************************************
' Purpose:   创建凸轮组
'
' Inputs :   dAngle:     凸轮组角度
'            dRefDis:    凸轮组起始位置
' **************************************************************************
Sub CreateCamSet(dAngle As Double, dRefDis As Double)
    
    CreateBearing dCamSetDis, dRefDis
    CreateCam dAngle, dCamSetDis - 3 * dCamThickness + dRefDis
    CreateCam dAngle, dCamSetDis - dCamThickness + dRefDis
    
End Sub

' **************************************************************************
' Purpose:   创建驱动轮
'
' Inputs :   dRefDis:    驱动轮起始位置
'
' **************************************************************************
Sub CreateDriveWheel(dRefDis As Double)
    
    CreateBearing dCamSetDis, dRefDis
  
  ' Create a sketch
  ' ---------------
    Dim oSketch  As Sketch
    Set oSketch = oBody.Sketches.Add(oRefPlane)

  ' Create base elements in the sketch
  ' ----------------------------------
    Dim oFactory2D As Factory2D
    Set oFactory2D = oSketch.OpenEdition

        Dim oCircle As Circle2D
        Set oCircle = oFactory2D.CreateClosedCircle(0, 0, dDriveWheelRadius)
    
    oSketch.CloseEdition
    
    Dim oPadBearing As Pad
    Set oPadBearing = oSF.AddNewPad(oSketch, 20)
    
    oPadBearing.FirstLimit.Dimension.Value = dRefDis + dCamSetDis
    oPadBearing.SecondLimit.Dimension.Value = _
            (dRefDis + dCamSetDis - dCamThickness) * -1
    
End Sub