functions.bas

CATIA二次开发

Attribute VB_Name = "Functions"
Option Explicit
' ***********************************************************************
'   Purpose:      功能模块
'   Assumtions:
'   Author:       SUNNYTECH Huting
'   Languages:    VBScript
'   Locales:      Chinese
'   CATIA Level:  V5R14
' ***********************************************************************

' 楼梯参数
Dim iPitch As Double
Dim iStairCount As Long
Dim iStairHeight As Double
'----------------------------

' 主控元素
Dim oCenterLine As Reference
Dim oHelix As Reference
Dim oCenterExtrude As Reference
'----------------------------

' 参考平面
Dim oRefPlanes() As Reference
'----------------------------

' 构造点
Dim oConstructPointCenter() As Reference
Dim oConstructPointOnHelix() As Reference
Dim oConstructPointProject() As Reference
'----------------------------

' 构造线
Dim oConstructLineHorizon() As Reference
Dim oConstructLineVertical() As Reference
Dim oConstructCircle() As Reference
'----------------------------

' 台阶曲面
Dim oHorizonSurface() As Reference
Dim oVerticalSurface() As Reference
'----------------------------

' ***********************************************************************
'   Purpose:      初始化全局变量
' ***********************************************************************
Sub InitVars()

'    iPitch = 3000
'    iStairCount = 12+1
'    iStairHeight = 200
    
    iStairCount = Val(Form1.txtStairCount) + 1
    iStairHeight = Val(Form1.txtStairHeight)
    iPitch = Val(Form1.txtPitch)

End Sub

' ***********************************************************************
'   Purpose:      创建主控元素
' ***********************************************************************
Sub MasterElements()
    
    Set oHBody = AddHBody("主控元素")
    
    ' 创建中心点及螺旋线的起点
    Dim Point1 As Object, Point2 As Object
    
    Set Point1 = oHSF.AddNewPointCoord(0, 0, 0)
    Set Point2 = oHSF.AddNewPointCoord(1000, 0, 0)
    
'    oHBody.AppendHybridShape Point1
'    oHBody.AppendHybridShape Point2
    
    ' 创建螺旋线的方向参考元素
    Dim Dir As Object
    Set Dir = oHSF.AddNewDirectionByCoord(0, 0, 1)
    
    ' 创建中心线
    Dim oLine As Object
    Set oLine = oHSF.AddNewLinePtDir(Point1, Dir, 0, (iStairCount + 1) * iStairHeight, False)
    oHBody.AppendHybridShape oLine
    Set oCenterLine = oPart.CreateReferenceFromObject(oLine)
    
    ' 隐藏中间过程的元素
'    HideShow Point1
'    HideShow Point2
    HideShow oLine

    ' 创建螺旋线
    Dim RefH1 As Object
    Set RefH1 = oPart.CreateReferenceFromObject(oLine)

    Dim RefH2 As Object
    Set RefH2 = oPart.CreateReferenceFromObject(Point2)

    Dim Helix As Object
    Set Helix = oHSF.AddNewHelix(RefH1, False, RefH2, iPitch, (iStairCount + 1) * iStairHeight, False, 0, 0, False)
    oHBody.AppendHybridShape Helix
    Set oHelix = oPart.CreateReferenceFromObject(Helix)
    
    ' 中心圆柱面
    Dim oCylinder As HybridShapeCylinder
    Set oCylinder = oHSF.AddNewCylinder(Point1, 200, (iStairCount + 1) * iStairHeight, 0, Dir)
    oHBody.AppendHybridShape oCylinder
    Set oCenterExtrude = oPart.CreateReferenceFromObject(oCylinder)

End Sub

' ***********************************************************************
'   Purpose:      创建参考平面
' ***********************************************************************
Sub ReferencePlanes()
    
    Set oHBody = AddHBody("台阶参考面")
    HideShow oHBody
    
    Dim i As Integer
    Dim oPlane As Plane
    
    ReDim oRefPlanes(iStairCount)
    
    Dim RefBasePlane As Reference
    
    Set RefBasePlane = oPart.CreateReferenceFromObject(oPart.OriginElements.PlaneXY)
    
    For i = 1 To iStairCount
        Set oPlane = oHSF.AddNewPlaneOffset(RefBasePlane, i * iStairHeight, False)
        Set oRefPlanes(i) = oPart.CreateReferenceFromObject(oPlane)
        oHBody.AppendHybridShape oPlane
    Next
    
End Sub

' ***********************************************************************
'   Purpose:      创建构造点
' ***********************************************************************
Sub ConstructPoints()
    
    Dim i As Integer
    Dim oIntersection As Object
    Dim oProject As Object
    
    ReDim oConstructPointCenter(iStairCount)
    ReDim oConstructPointOnHelix(iStairCount)
    ReDim oConstructPointProject(iStairCount)
    
    Set oHBody = AddHBody("构造点")
    HideShow oHBody
    
    For i = 1 To iStairCount
        Set oIntersection = oHSF.AddNewIntersection(oRefPlanes(i), oCenterLine)
        Set oConstructPointCenter(i) = oPart.CreateReferenceFromObject(oIntersection)
        oHBody.AppendHybridShape oIntersection
        
        Set oIntersection = oHSF.AddNewIntersection(oRefPlanes(i), oHelix)
        Set oConstructPointOnHelix(i) = oPart.CreateReferenceFromObject(oIntersection)
        oHBody.AppendHybridShape oIntersection
        
        If i > 1 Then
            Set oProject = oHSF.AddNewProject(oIntersection, oRefPlanes(i - 1))
            Set oConstructPointProject(i - 1) = oPart.CreateReferenceFromObject(oProject)
            oHBody.AppendHybridShape oProject
        End If
    Next
    
End Sub

' ***********************************************************************
'   Purpose:      创建构造线
' ***********************************************************************
Sub ConstructLines()
    
    Dim i As Integer
    Dim oLine As Object, oCircle As Object
    
    ReDim oConstructLineHorizon(iStairCount)
    ReDim oConstructLineVertical(iStairCount)
    ReDim oConstructCircle(iStairCount)
    
    Set oHBody = AddHBody("构造线")
    HideShow oHBody
    
    For i = 1 To iStairCount - 1
        Set oLine = oHSF.AddNewLinePtPt(oConstructPointCenter(i), oConstructPointOnHelix(i))
        Set oConstructLineHorizon(i) = oPart.CreateReferenceFromObject(oLine)
        oHBody.AppendHybridShape oLine
        
        Set oLine = oHSF.AddNewLinePtPt(oConstructPointCenter(i), oConstructPointProject(i))
        Set oConstructLineVertical(i) = oPart.CreateReferenceFromObject(oLine)
        oHBody.AppendHybridShape oLine
        
        Set oCircle = oHSF.AddNewCircle2PointsRad _
                        (oConstructPointOnHelix(i), oConstructPointProject(i), oRefPlanes(i), False, 1000, 1)
        Set oConstructCircle(i) = oPart.CreateReferenceFromObject(oCircle)
        oHBody.AppendHybridShape oCircle
    Next
    
    
End Sub

' ***********************************************************************
'   Purpose:      创建台阶曲面
' ***********************************************************************
Sub StairSurfaces()
    
    Dim i As Integer
    Dim oFill As HybridShapeFill
    Dim oExtrude As HybridShapeExtrude

    ReDim oHorizonSurface(iStairCount - 1)
    ReDim oVerticalSurface(iStairCount - 1)
    
    Dim FillEdge1 As Object
    Dim FillEdge2 As Object
    Dim FillEdge3 As Object

    Dim Dir As Object
    Set Dir = oHSF.AddNewDirection(oCenterLine)
    
    Set oHBody = AddHBody("构造面")
    HideShow oHBody
    
    For i = 1 To iStairCount - 1
        
        Set oFill = oHSF.AddNewFill
        
        Set FillEdge1 = oHSF.AddNewFillEdge(oConstructLineHorizon(i), 0, 0)
        Set FillEdge2 = oHSF.AddNewFillEdge(oConstructLineVertical(i), 0, 0)
        Set FillEdge3 = oHSF.AddNewFillEdge(oConstructCircle(i), 0, 0)
        
        oFill.AddFillEdge FillEdge1
        oFill.AddFillEdge FillEdge2
        oFill.AddFillEdge FillEdge3
        
        oHBody.AppendHybridShape oFill
        
        Set oExtrude = oHSF.AddNewExtrude(oConstructLineVertical(i), iStairHeight, 0, Dir)
        oHBody.AppendHybridShape oExtrude
        
        Set oHorizonSurface(i) = oPart.CreateReferenceFromObject(oFill)
        Set oVerticalSurface(i) = oPart.CreateReferenceFromObject(oExtrude)
        
    Next
    
End Sub

' ***********************************************************************
'   Purpose:      组合曲面并裁剪
' ***********************************************************************
Sub Assemble()
    
    Dim i As Integer
    
    Set oHBody = AddHBody("组合")
    
    Dim oJoin As HybridShapeAssemble
    Set oJoin = oHSF.AddNewJoin(oHorizonSurface(1), oVerticalSurface(1))
    
    For i = 2 To iStairCount - 1
        oJoin.AddElement oHorizonSurface(i)
        oJoin.AddElement oVerticalSurface(i)
    Next
    
    oHBody.AppendHybridShape oJoin
    
    Dim refJoin As Reference
    Set refJoin = oPart.CreateReferenceFromObject(oJoin)
    
    HideShow oJoin
        
    Dim oSplit As Object
    Set oSplit = oHSF.AddNewHybridSplit(oJoin, oCenterExtrude, 1)
    oHBody.AppendHybridShape oSplit
    
End Sub