鱼眼灯花.bas

CATIA二次开发

    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 = "initPointHighStartM"
    
    Set refPt = oPart.CreateReferenceFromObject(initPoint)
    Set refSurf = BaseSurfMidOffset
    
    For i = 1 To DHCount
        
        Set initPoint = oHSF.AddNewPointOnCurveWithReferenceFromDistance(BaseCurve, refPt, 2, 0)
        'Set Formula = relations.CreateFormula("pF_" & Trim(Str(i)), "", initPoint.Offset, "WidthHigh+" & 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 IntCurveHighM(i) = oHSF.AddNewIntersection(BaseSurfMidOffset, refPlane)
        oHBody.AppendHybridShape IntCurveHighM(i)
        IntCurveHighM(i).Name = "IntCurveHighM_" & Trim(Str(i))
    
    Next
        
    oPart.Update
    
End Sub

Sub CreateIntersectionMH()
    
    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("边界底部MH")
    
    ReDim IntCurveLowMH(DHCountH + 1)
    ReDim IntCurveHighMH(DHCountH)
    
    Set refPt = StPt1H
    Set RefGuide = GuideCurveH
    
    For i = 1 To DHCountH + 1
        
        Set initPoint = oHSF.AddNewPointOnCurveWithReferenceFromDistance(BaseCurveH, refPt, 2, 0)
        'Set Formula = relations.CreateFormula("pF_" & Trim(Str(i)), "", initPoint.Offset, "WidthLowH+" & Str(i) & "*incH")
        'oHBody.AppendHybridShape initPoint
        
        Set refPt = oPart.CreateReferenceFromObject(initPoint)
        Set initPlane = oHSF.AddNewPlaneNormal(RefGuide, refPt)
        'oHBody.AppendHybridShape initPlane
        
        Set refPlane = oPart.CreateReferenceFromObject(initPlane)
        Set IntCurveLowMH(i) = oHSF.AddNewIntersection(BaseSurfMidOffset, refPlane)
        oHBody.AppendHybridShape IntCurveLowMH(i)
        IntCurveLowMH(i).Name = "IntCurveLowMH_" & Trim(Str(i))
    
    Next
    
    ' Create Hight Points
    Set oHBody = AddHBody("边界顶部MH")
    
    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 = "initPointHighStartMH"
    oHSF.GSMVisibility initPoint, 0
    
    Set refPt = oPart.CreateReferenceFromObject(initPoint)
    Set refSurf = BaseSurfMidOffset
    
    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) & "*incH")
        'oHBody.AppendHybridShape initPoint
        
        Set refPt = oPart.CreateReferenceFromObject(initPoint)
        Set initPlane = oHSF.AddNewPlaneNormal(RefGuide, refPt)
        'oHBody.AppendHybridShape initPlane
        
        Set refPlane = oPart.CreateReferenceFromObject(initPlane)
        Set IntCurveHighMH(i) = oHSF.AddNewIntersection(BaseSurfMidOffset, refPlane)
        oHBody.AppendHybridShape IntCurveHighMH(i)
        IntCurveHighMH(i).Name = "IntCurveHighMH_" & Trim(Str(i))
    
    Next
        
    oPart.Update
    
End Sub

'生成圆弧线
Sub CreateCircleCurve()
    
    Dim refCurve As Reference
    Dim refCurveH As Reference
    
    Dim refPt1 As Reference
    Dim refPt2 As Reference
    Dim refPt3 As Reference
    Dim i As Integer, j As Integer
    
    Set oHBody = AddHBody("底部点")
    
    ReDim IntPtLow(DHCount + 1, DHCountH + 1)
    
    For i = 1 To DHCount + 1
        
        Set refCurve = oPart.CreateReferenceFromObject(IntCurveLow(i))
        
        For j = 1 To DHCountH + 1
            
            Set refCurveH = oPart.CreateReferenceFromObject(IntCurveLowH(j))
            
            Set IntPtLow(i, j) = oHSF.AddNewIntersection(refCurve, refCurveH)
            oHBody.AppendHybridShape IntPtLow(i, j)
            IntPtLow(i, j).Name = "IntPtLow_" & Trim(Str(i)) & "_" & Trim(Str(j))
            
        Next

    Next
    
    frmProgress.lblProgress.Caption = "正在生成构造线...已完成15%"
    frmProgress.Repaint
    DoEvents

    Set oHBody = AddHBody("中间点")
    
    ReDim IntPtMid(DHCount + 1, DHCountH + 1)
    
    For i = 1 To DHCount + 1
        
        Set refCurve = oPart.CreateReferenceFromObject(IntCurveLowM(i))
        
        For j = 1 To DHCountH
            
            Set refCurveH = oPart.CreateReferenceFromObject(IntCurveHighMH(j))
            
            Set IntPtMid(i, j) = oHSF.AddNewIntersection(refCurve, refCurveH)
            oHBody.AppendHybridShape IntPtMid(i, j)
            IntPtMid(i, j).Name = "IntPtLowM_" & Trim(Str(i)) & "_" & Trim(Str(j))
            
        Next

    Next
    
    frmProgress.lblProgress.Caption = "正在生成构造线...已完成30%"
    frmProgress.Repaint
    DoEvents
    
    Set oHBody = AddHBody("中间点H")
    
    ReDim IntPtMidH(DHCount + 1, DHCountH + 1)
    
    For i = 1 To DHCount
        
        Set refCurve = oPart.CreateReferenceFromObject(IntCurveHighM(i))
        
        For j = 1 To DHCountH + 1
            
            Set refCurveH = oPart.CreateReferenceFromObject(IntCurveLowMH(j))
            
            Set IntPtMidH(i, j) = oHSF.AddNewIntersection(refCurve, refCurveH)
            oHBody.AppendHybridShape IntPtMidH(i, j)
            IntPtMidH(i, j).Name = "IntPtLowMH_" & Trim(Str(i)) & "_" & Trim(Str(j))
            
        Next

    Next
    
    frmProgress.lblProgress.Caption = "正在生成构造线...已完成45%"
    frmProgress.Repaint
    DoEvents
    
'    Set oHBody = AddHBody("顶部点")
'
'    ReDim IntPtHigh(DHCount, DHCountH)
'
'    For i = 1 To DHCount
'
'        Set refCurve = oPart.CreateReferenceFromObject(IntCurveHigh(i))
'
'        For j = 1 To DHCountH
'
'            Set refCurveH = oPart.CreateReferenceFromObject(IntCurveHighH(j))
'
'            Set IntPtHigh(i, j) = oHSF.AddNewIntersection(refCurve, refCurveH)
'            oHBody.AppendHybridShape IntPtHigh(i, j)
'            IntPtHigh(i, j).Name = "IntPtHigh_" & Trim(Str(i)) & "_" & Trim(Str(j))
'
'        Next
'
'    Next
'
'    frmProgress.lblProgress.Caption = "正在生成构造线...已完成60%"
'    frmProgress.Repaint
'    DoEvents

    
    Set oHBody = AddHBody("构造线")
    
    ReDim CircleCurve(DHCount, DHCountH + 1)
    ReDim CircleCurveH(DHCount + 1, DHCountH + 1)
    
    For i = 1 To DHCount
        
        For j = 1 To DHCountH
            
            Set refPt1 = oPart.CreateReferenceFromObject(IntPtLow(i, j))
            Set refPt2 = oPart.CreateReferenceFromObject(IntPtMidH(i, j))
            Set refPt3 = oPart.CreateReferenceFromObject(IntPtLow(i + 1, j))
            
            Set CircleCurve(i, j) = oHSF.AddNewCircle3Points(refPt1, refPt2, refPt3)
            oHBody.AppendHybridShape CircleCurve(i, j)
            CircleCurve(i, j).Name = "FillCurve_" & Trim(Str(i)) & "_" & Trim(Str(j))
            
            Set refPt1 = oPart.CreateReferenceFromObject(IntPtLow(i, j))
            Set refPt2 = oPart.CreateReferenceFromObject(IntPtMid(i, j))
            Set refPt3 = oPart.CreateReferenceFromObject(IntPtLow(i, j + 1))
            
            Set CircleCurveH(i, j) = oHSF.AddNewCircle3Points(refPt1, refPt2, refPt3)
            oHBody.AppendHybridShape CircleCurveH(i, j)
            CircleCurveH(i, j).Name = "FillCurveH_" & Trim(Str(i)) & "_" & Trim(Str(j))
            
        Next

        Set refPt1 = oPart.CreateReferenceFromObject(IntPtLow(i, j))
        Set refPt2 = oPart.CreateReferenceFromObject(IntPtMidH(i, j))
        Set refPt3 = oPart.CreateReferenceFromObject(IntPtLow(i + 1, j))
        
        Set CircleCurve(i, j) = oHSF.AddNewCircle3Points(refPt1, refPt2, refPt3)
        oHBody.AppendHybridShape CircleCurve(i, j)
        CircleCurve(i, j).Name = "FillCurve_" & Trim(Str(i)) & "_" & Trim(Str(j))
            
    Next
    
    frmProgress.lblProgress.Caption = "正在生成构造线...已完成90%"
    frmProgress.Repaint
    DoEvents

    For j = 1 To DHCountH
        
        Set refPt1 = oPart.CreateReferenceFromObject(IntPtLow(i, j))
        Set refPt2 = oPart.CreateReferenceFromObject(IntPtMid(i, j))
        Set refPt3 = oPart.CreateReferenceFromObject(IntPtLow(i, j + 1))
        
        Set CircleCurveH(i, j) = oHSF.AddNewCircle3Points(refPt1, refPt2, refPt3)
        oHBody.AppendHybridShape CircleCurveH(i, j)
        CircleCurveH(i, j).Name = "FillCurveH_" & Trim(Str(i)) & "_" & Trim(Str(j))
    
    Next
            
    frmProgress.lblProgress.Caption = "构造线生成完毕，正在更新..."
    frmProgress.Repaint
    DoEvents

    oPart.Update

End Sub

'生成鱼眼曲面
Sub CreateSurf()

    Dim FillSurf As HybridShapeFill
    
    Dim refCrv1 As Object
    Dim refCrv2 As Object
    Dim refCrv3 As Object
    Dim refCrv4 As Object
    Dim i As Integer, j As Integer
    
    Set oHBody = AddHBody("鱼眼面")

    
    For i = 1 To DHCount
        
        For j = 1 To DHCountH
            
            Set refCrv1 = oHSF.AddNewFillEdge(CircleCurve(i, j), 0, 0)
            Set refCrv2 = oHSF.AddNewFillEdge(CircleCurveH(i, j), 0, 0)
            Set refCrv3 = oHSF.AddNewFillEdge(CircleCurve(i, j + 1), 0, 0)
            Set refCrv4 = oHSF.AddNewFillEdge(CircleCurveH(i + 1, j), 0, 0)
            
            Set FillSurf = oHSF.AddNewFill()
            
            FillSurf.AddFillEdge refCrv1
            FillSurf.AddFillEdge refCrv2
            FillSurf.AddFillEdge refCrv3
            FillSurf.AddFillEdge refCrv4
            
            oHBody.AppendHybridShape FillSurf
            
            FillSurf.Name = "FillSurf_" & Trim(Str(i)) & "_" & Trim(Str(j))
        
        Next
        
        frmProgress.lblProgress.Caption = "正在生成鱼眼...已完成" & Trim(Str(Int(i / DHCount * 100))) & "%"
        frmProgress.Repaint
        DoEvents
    
    Next
    
    frmProgress.lblProgress.Caption = "鱼眼生成完毕，正在更新..."
    frmProgress.Repaint
    DoEvents
    
    oPart.Update

End Sub