鱼眼灯花.bas

CATIA二次开发

    Loop
    
    frmDHGen.txtGuideCurveH.Text = GuideCurveH.Name
    
    frmDHGen.txtStPt1H.SetFocus
    frmDHGen.txtStPt1H.SelStart = 0
    frmDHGen.txtStPt1H.SelLength = Len(frmDHGen.txtStPt1H.Text)
    
    Do While Not DefineStPt1Finished
    
        ReDim InputObjectType(1)
        InputObjectType(0) = "Point"
        InputObjectType(1) = "Vertex"
        
        Status = Selection.SelectElement2(InputObjectType, "请选择起始点1(底边起始点)", True)
        
        If (Status = "Cancel") Then
            Exit Sub
        ElseIf (Status = "Redo") Then
'           We do nothing: Redo has no meaning in this context
        ElseIf (Status = "Undo") Then
            Exit Sub
        ElseIf (Status <> "Redo") Then
                
                Set StPt1H = Selection.Item(1).Value
                Selection.Clear
                DefineStPt1Finished = True
        
        Else
            Exit Sub
        End If
        
    Loop
    
    frmDHGen.txtStPt1H.Text = StPt1H.Name
    
    frmDHGen.txtStPt2H.SetFocus
    frmDHGen.txtStPt2H.SelStart = 0
    frmDHGen.txtStPt2H.SelLength = Len(frmDHGen.txtStPt2H.Text)
    
    Do While Not DefineStPt2Finished
    
        ReDim InputObjectType(1)
        InputObjectType(0) = "Point"
        InputObjectType(1) = "Vertex"
        
        Status = Selection.SelectElement2(InputObjectType, "请选择起始点2(顶边起始点)", True)
        
        If (Status = "Cancel") Then
            Exit Sub
        ElseIf (Status = "Redo") Then
'           We do nothing: Redo has no meaning in this context
        ElseIf (Status = "Undo") Then
            Exit Sub
        ElseIf (Status <> "Redo") Then
                
                Set StPt2H = Selection.Item(1).Value
                Selection.Clear
                DefineStPt2Finished = True
        
        Else
            Exit Sub
        End If
        
    Loop
    
    frmDHGen.txtStPt2H.Text = StPt2H.Name
    
    DefineFinished_Step2 = True
    
    
End Sub

'设定参数
Sub SetPar()
    
    DHHeight = Val(frmDHGen.txtHeight.Text)
    DHWidth = Val(frmDHGen.txtWidth.Text)
    DHCount = Val(frmDHGen.txtCount.Text)
    
    DHWidthH = Val(frmDHGen.txtWidthH.Text)
    DHCountH = Val(frmDHGen.txtCountH.Text)
    
'    ' Set Parameters for stair generation
'    Set Parm = parameters.CreateDimension("Height", "LENGTH", DHHeight)
'    Set Parm = parameters.CreateDimension("WidthLow", "LENGTH", DHWidth)
'    Set Parm = parameters.CreateDimension("WidthHigh", "LENGTH", DHWidth)
'    'Set Formula = relations.CreateFormula("WidthHighF", "", Parm, "WidthLow")
'
'    Set Parm = parameters.CreateDimension("MidHeight", "LENGTH", DHHeight / 2)
'    'Set Formula = relations.CreateFormula("HalfOffsetF", "", Parm, "Height/2")
'
'    Set Parm = parameters.CreateDimension("WidthLowH", "LENGTH", DHWidthH)
'    Set Parm = parameters.CreateDimension("WidthHighH", "LENGTH", DHWidthH)
'    'Set Formula = relations.CreateFormula("WidthHighHF", "", Parm, "WidthLowH")
'
'    Set Parm = parameters.CreateDimension("inc", "LENGTH", 0#)
'    Set Parm = parameters.CreateDimension("incH", "LENGTH", 0#)
    
End Sub

'创建基础元素
Sub CreateBaseElement()
    
    ' Adding an OpenBody
    Set oHBody = AddHBody("基础元素")
    HideShow oHBody
    
    Dim oBaseSurfOffset As Object
    
'    ' Create offset surface
'    Set oBaseSurfOffset = oHSF.AddNewOffset(BaseSurf, DHHeight, 0, 0)
'    oHBody.AppendHybridShape oBaseSurfOffset
'    oBaseSurfOffset.Name = "BaseSurfOffset"
'    ' Create formula defining
'    'Set Formula = relations.CreateFormula("BaseSurfOffsetF", "", oBaseSurfOffset.OffsetValue, "Height")
'
'    Set BaseSurfOffset = oPart.CreateReferenceFromObject(oBaseSurfOffset)
    
    Set oBaseSurfOffset = oHSF.AddNewOffset(BaseSurf, DHHeight / 2, 0, 0)
    oHBody.AppendHybridShape oBaseSurfOffset
    oBaseSurfOffset.Name = "BaseSurfMidOffset"
    ' Create formula defining
    'Set Formula = relations.CreateFormula("BaseSurfOffsetF", "", oBaseSurfOffset.OffsetValue, "MidHeight")
    
    Set BaseSurfMidOffset = oPart.CreateReferenceFromObject(oBaseSurfOffset)
    
    oPart.Update
    
End Sub

'生成交线
Sub CreateIntersection()
    
    Dim initPoint As HybridShapePointOnCurve
    Dim initPlane As Object
    Dim refPt As Reference
    Dim RefGuide As Reference
    Dim refPlane As Reference
    Dim refSurf As Reference
    
    Dim i As Integer
    
    ' --------------------------------------------------------------
    ' 创建等分点
    ' --------------------------------------------------------------
    ' Create Low Points
    Set oHBody = AddHBody("边界底部")
    
    ReDim IntCurveLow(DHCount + 1)
    ReDim IntCurveHigh(DHCount)
    
    Set refPt = StPt1
    Set RefGuide = GuideCurve
    
    For i = 1 To DHCount + 1
        
        Set initPoint = oHSF.AddNewPointOnCurveWithReferenceFromDistance(BaseCurve, refPt, 2, 0)
        'oHBody.AppendHybridShape initPoint
        'Set Formula = relations.CreateFormula("pF_" & Trim(Str(i)), "", initPoint.Offset, "WidthLow+" & Str(i) & "*inc")
        
        Set refPt = oPart.CreateReferenceFromObject(initPoint)
        Set initPlane = oHSF.AddNewPlaneNormal(RefGuide, refPt)
        'oHBody.AppendHybridShape initPlane
        
        Set refPlane = oPart.CreateReferenceFromObject(initPlane)
        Set IntCurveLow(i) = oHSF.AddNewIntersection(BaseSurf, refPlane)
        oHBody.AppendHybridShape IntCurveLow(i)
        IntCurveLow(i).Name = "IntCurveLow_" & Trim(Str(i))
    
    Next
    
'    ' Create Hight Points
'    Set oHBody = AddHBody("边界顶部")
'
'    Set refPt = StPt2
'    Set initPoint = oHSF.AddNewPointOnCurveWithReferenceFromDistance(BaseCurve, refPt, 1, 0)
'    oHBody.AppendHybridShape initPoint
'    'Set Formula = relations.CreateFormula("pF_" & Trim(Str(i)), "", initPoint.Offset, "WidthHigh/2+" & Str(i) & "*inc+inc/2")
'    initPoint.Name = "initPointHighStart"
'
'    Set refPt = oPart.CreateReferenceFromObject(initPoint)
'    Set refSurf = BaseSurfOffset
'
'    For i = 1 To DHCount
'
'        Set initPoint = oHSF.AddNewPointOnCurveWithReferenceFromDistance(BaseCurve, refPt, 2, 0)
'        'oHBody.AppendHybridShape initPoint
'        'Set Formula = relations.CreateFormula("pF_" & Trim(Str(i)), "", initPoint.Offset, "WidthHigh")
'
'        Set refPt = oPart.CreateReferenceFromObject(initPoint)
'        Set initPlane = oHSF.AddNewPlaneNormal(RefGuide, refPt)
'        'oHBody.AppendHybridShape initPlane
'
'        Set refPlane = oPart.CreateReferenceFromObject(initPlane)
'        Set IntCurveHigh(i) = oHSF.AddNewIntersection(refSurf, refPlane)
'        oHBody.AppendHybridShape IntCurveHigh(i)
'        IntCurveHigh(i).Name = "IntCurveHigh_" & Trim(Str(i))
'
'    Next
        
    oPart.Update
    
End Sub

Sub CreateIntersectionH()
    
    Dim initPoint As HybridShapePointOnCurve
    Dim initPlane As Object
    Dim refPt As Reference
    Dim RefGuide As Reference
    Dim refPlane As Reference
    Dim refSurf As Reference
    
    Dim i As Integer
    
    ' --------------------------------------------------------------
    ' 创建等分点
    ' --------------------------------------------------------------
    ' Create Low Points
    Set oHBody = AddHBody("边界底部H")
    
    ReDim IntCurveLowH(DHCountH + 1)
    ReDim IntCurveHighH(DHCountH)
    
    Set refPt = StPt1H
    Set RefGuide = GuideCurveH
    
    For i = 1 To DHCountH + 1
        
        Set initPoint = oHSF.AddNewPointOnCurveWithReferenceFromDistance(BaseCurveH, refPt, 2, 0)
        'oHBody.AppendHybridShape initPoint
        'Set Formula = relations.CreateFormula("pF_" & Trim(Str(i)), "", initPoint.Offset, "WidthLowH+" & Str(i) & "*incH")
        
        Set refPt = oPart.CreateReferenceFromObject(initPoint)
        Set initPlane = oHSF.AddNewPlaneNormal(RefGuide, refPt)
        'oHBody.AppendHybridShape initPlane
        
        Set refPlane = oPart.CreateReferenceFromObject(initPlane)
        Set IntCurveLowH(i) = oHSF.AddNewIntersection(BaseSurf, refPlane)
        oHBody.AppendHybridShape IntCurveLowH(i)
        IntCurveLowH(i).Name = "IntCurveLowH_" & Trim(Str(i))
    
    Next
    
'    ' Create Hight Points
'    Set oHBody = AddHBody("边界顶部H")
'
'    Set refPt = StPt2H
'    Set initPoint = oHSF.AddNewPointOnCurveWithReferenceFromDistance(BaseCurveH, refPt, 1, 0)
'    oHBody.AppendHybridShape initPoint
'    'Set Formula = relations.CreateFormula("pF_" & Trim(Str(i)), "", initPoint.Offset, "WidthHighH/2+" & Str(i) & "*incH+incH/2")
'    initPoint.Name = "initPointHighStart"
'
'    Set refPt = oPart.CreateReferenceFromObject(initPoint)
'    Set refSurf = BaseSurfOffset
'
'    For i = 1 To DHCountH
'
'        Set initPoint = oHSF.AddNewPointOnCurveWithReferenceFromDistance(BaseCurveH, refPt, 2, 0)
'        'Set Formula = relations.CreateFormula("pF_" & Trim(Str(i)), "", initPoint.Offset, "WidthHighH+" & Str(i) & "*inc")
'        'oHBody.AppendHybridShape initPoint
'
'        Set refPt = oPart.CreateReferenceFromObject(initPoint)
'        Set initPlane = oHSF.AddNewPlaneNormal(RefGuide, refPt)
'        'oHBody.AppendHybridShape initPlane
'
'        Set refPlane = oPart.CreateReferenceFromObject(initPlane)
'        Set IntCurveHighH(i) = oHSF.AddNewIntersection(refSurf, refPlane)
'        oHBody.AppendHybridShape IntCurveHighH(i)
'        IntCurveHighH(i).Name = "IntCurveHighH_" & Trim(Str(i))
'
'    Next
        
    oPart.Update
    
End Sub

Sub CreateIntersectionM()
    
    Dim initPoint As HybridShapePointOnCurve
    Dim initPlane As Object
    Dim refPt As Reference
    Dim RefGuide As Reference
    Dim refPlane As Reference
    Dim refSurf As Reference
    
    Dim i As Integer
    
    ' --------------------------------------------------------------
    ' 创建等分点
    ' --------------------------------------------------------------
    ' Create Low Points
    Set oHBody = AddHBody("边界底部M")
    
    ReDim IntCurveLowM(DHCount + 1)
    ReDim IntCurveHighM(DHCount)
    
    Set refPt = StPt1
    Set RefGuide = GuideCurve
    
    For i = 1 To DHCount + 1
        
        Set initPoint = oHSF.AddNewPointOnCurveWithReferenceFromDistance(BaseCurve, refPt, 2, 0)
        'Set Formula = relations.CreateFormula("pF_" & Trim(Str(i)), "", initPoint.Offset, "WidthLow+" & Str(i) & "*inc")
        'oHBody.AppendHybridShape initPoint
        
        Set refPt = oPart.CreateReferenceFromObject(initPoint)
        Set initPlane = oHSF.AddNewPlaneNormal(RefGuide, refPt)
        'oHBody.AppendHybridShape initPlane
        
        Set refPlane = oPart.CreateReferenceFromObject(initPlane)
        Set IntCurveLowM(i) = oHSF.AddNewIntersection(BaseSurfMidOffset, refPlane)
        oHBody.AppendHybridShape IntCurveLowM(i)
        IntCurveLowM(i).Name = "IntCurveLowM_" & Trim(Str(i))
    
    Next
    
    ' Create Hight Points
    Set oHBody = AddHBody("边界顶部M")
    
    Set refPt = StPt2