New User With you's questions

我有一个可以创建 4 个点的宏，每个点的长度都链接到一个已设置的参数。但这只是第一次创建点。我希望有一个完整的链接，例如，如果参数值有任何更新，每个点的长度应该会相应更新。谢谢

更多细节：如果我双击通过此代码创建的点，我需要看到长度 = 值 = CATIA_V5R22_VENT-HOLES-DEFINITION-BACKREST_V01\HOLES_PARAMETERS\HOLE_RADIUS

不是这样的长度=值

    Private Function GetParameterValue(part As Object, categoryName As String, parameterName As String) As Double
    Dim parameters As Object
    Dim parameter As Object
    Set parameters = part.parameters
    On Error Resume Next
    Set parameter = parameters.Item(categoryName & "\" & parameterName)
    If Not parameter Is Nothing Then
        GetParameterValue = parameter.value
    Else
        GetParameterValue = 0  ' Default value if the parameter doesn't exist
    End If
    On Error GoTo 0
End Function


Sub points(hybridBody As Object)
    Dim partDocument As Object
    Set partDocument = CATIA.Documents.Item("CATIA_V5R22_VENT-HOLES-DEFINITION-BACKREST_V01.CATPart")
    Dim part1 As Object
    Set part1 = partDocument.part
    
    ' Retrieve the value of the hole radius
    Dim holeRadius As Double
    holeRadius = GetParameterValue(part1, "HOLES_PARAMETERS", "HOLE_RADIUS")
    
    Dim hybridShapes1 As Object
    Set hybridShapes1 = hybridBody.hybridShapes
    Dim hybridShapeLinePtDir1 As Object
    Set hybridShapeLinePtDir1 = hybridShapes1.Item("Horiz. Axis")
    
    Dim reference1 As Object
    Set reference1 = part1.CreateReferenceFromObject(hybridShapeLinePtDir1)
    
    Dim hybridShapeIntersection1 As Object
    Set hybridShapeIntersection1 = hybridShapes1.Item("Inter. Right")
    Dim reference2 As Object
    Set reference2 = part1.CreateReferenceFromObject(hybridShapeIntersection1)
    
    Dim hybridShapeFactory1 As Object
    Set hybridShapeFactory1 = part1.hybridShapeFactory
    Dim hybridShapePointOnCurve1 As Object
    Set hybridShapePointOnCurve1 = hybridShapeFactory1.AddNewPointOnCurveWithReferenceFromDistance(reference1, reference2, holeRadius, True)
    hybridShapePointOnCurve1.distanceType = 1
    hybridShapePointOnCurve1.Name = "Point.1"
    hybridBody.AppendHybridShape hybridShapePointOnCurve1
    part1.InWorkObject = hybridShapePointOnCurve1
    part1.Update

    part1.Update
End Sub

我已经开发了一个宏，它可以在从另一个 Catpart 粘贴的实体上创建厚度操作。它可以工作，但我面临的问题是，此代码中的面 ID 有时与操作中的面 ID 不一致。有没有办法避免面 ID 并自动从粘贴的实体中捕获所有面并进行厚度操作。在下面的代码中，您可以看到许多面 ID，有时它可以工作，有时 Catia 会询问缺失的面。非常感谢

Sub ThicknessOP()
    Dim partDocument1 As Object
    Set partDocument1 = CATIA.activeDocument

    Dim part1 As Object
    Set part1 = partDocument1.part

    Dim bodies1 As Object
    Set bodies1 = part1.bodies

    ' Modify input body name and thickness name here
    Dim bodyName As String
    Dim thicknessName As String

    bodyName = "FOAM_HOLES" ' Change this to the desired body name
    thicknessName = "ThicknessOperation" ' Change this to the desired thickness name

    Dim body1 As Object
    Set body1 = bodies1.Item(bodyName)

    Dim shapes1 As Object
    Set shapes1 = body1.Shapes

    ' Try to retrieve the thickness shape
    Dim thickness1 As Object
    On Error Resume Next ' Enable error handling
    Set thickness1 = shapes1.Item(thicknessName)
    On Error GoTo 0 ' Disable error handling

    ' Check if the thickness has been retrieved
    If thickness1 Is Nothing Then
        MsgBox "Error: " & thicknessName & " not found in " & bodyName & ". Please verify the name.", vbExclamation
        Exit Sub
    End If

    Dim solid1 As Object
    Dim solidFound As Boolean
    solidFound = False

    ' Loop through all solids in the body to find the desired solid
    Dim i As Integer
    For i = 1 To shapes1.Count
        Set solid1 = shapes1.Item(i)
        If solid1.Name Like "Solid.*" Then
            solidFound = True
            Exit For
        End If
    Next i

    If Not solidFound Then
        MsgBox "Error: Solid not found in " & bodyName & ". Please verify the name.", vbExclamation
        Exit Sub
    End If

    Dim faceIds As Variant
    faceIds = Array(4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38) ' Face IDs from 4 to 38
    
    Dim successfullyAdded As Integer
    Dim failedIds As String
    successfullyAdded = 0
    failedIds = ""

    ' Try to add each face to the thickness operation
    For i = LBound(faceIds) To UBound(faceIds)
        Dim reference As Object
        On Error Resume Next ' Enable error handling
        Set reference = part1.CreateReferenceFromBRepName("RSur:(Face:(Brp:(" & solid1.Name & ";%" & faceIds(i) & ");None:();Cf11:());WithTemporaryBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)", solid1)
        If Err.Number = 0 Then
            thickness1.AddFaceToThicken reference
            successfullyAdded = successfullyAdded + 1
        Else
            failedIds = failedIds & faceIds(i) & ", "
        End If
        On Error GoTo 0 ' Disable error handling
    Next i

    ' Update the thickening object
    part1.UpdateObject thickness1
    part1.Update

    ' Provide feedback on the operation
    If successfullyAdded > 0 Then
        MsgBox successfullyAdded & " face(s) added to the thickness operation." & vbCrLf & _
               "Failed face IDs: " & IIf(failedIds = "", "None", Left(failedIds, Len(failedIds) - 2)), vbInformation
    Else
        MsgBox "No faces were successfully added to the thickness operation." & vbCrLf & _
               "Failed face IDs: " & IIf(failedIds = "", "None", Left(failedIds, Len(failedIds) - 2)), vbExclamation
    End If

End Sub

宏是否有可能在移除操作后生成边缘圆角（仅适用于移除的孔）。我尝试了很多次使用 AI 编码，但没有得到任何解决方案。我唯一做的事情就是录制一个宏。（但这个宏使用特定的边缘和名称）它不适用于不同的部件或操作名称。

    Sub CATMain()

Dim partDocument1 As partDocument
Set partDocument1 = CATIA.activeDocument

Dim part1 As part
Set part1 = partDocument1.part

Dim shapeFactory1 As ShapeFactory
Set shapeFactory1 = part1.ShapeFactory

Dim reference1 As reference
Set reference1 = part1.CreateReferenceFromName("")

Dim constRadEdgeFillet1 As ConstRadEdgeFillet
Set constRadEdgeFillet1 = shapeFactory1.AddNewSolidEdgeFilletWithConstantRadius(reference1, catTangencyFilletEdgePropagation, 3#)

Dim bodies1 As bodies
Set bodies1 = part1.bodies

Dim body1 As body
Set body1 = bodies1.Item("PartBody")

Dim shapes1 As Shapes
Set shapes1 = body1.Shapes

Dim remove1 As Remove
Set remove1 = shapes1.Item("Remove.1")

Dim reference2 As reference
Set reference2 = part1.CreateReferenceFromBRepName("TgtIntersEdge:(GeneratedEdges;MfIE_R20SP4HFAA;TgtPropagationFillet;FirstOperands:(Remove.1);SecondOperands:();InitEdges:(REdge:(Edge:(Face:(Brp:(Solid.6;%21);None:();Cf11:());Face:(Brp:(Solid.5;%2);None:();Cf11:());None:(Limits1:();Limits2:());Cf11:());WithTemporaryBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)))", remove1)

constRadEdgeFillet1.AddObjectToFillet reference2

constRadEdgeFillet1.EdgePropagation = catTangencyFilletEdgePropagation

Dim reference3 As reference
Set reference3 = part1.CreateReferenceFromBRepName("TgtIntersEdge:(GeneratedEdges;MfIE_R20SP4HFAA;TgtPropagationFillet;FirstOperands:(Remove.1);SecondOperands:();InitEdges:(REdge:(Edge:(Face:(Brp:(Solid.6;%18);None:();Cf11:());Face:(Brp:(Solid.5;%2);None:();Cf11:());None:(Limits1:();Limits2:());Cf11:());WithTemporaryBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)))", remove1)

constRadEdgeFillet1.AddObjectToFillet reference3

constRadEdgeFillet1.EdgePropagation = catTangencyFilletEdgePropagation

Dim reference4 As reference
Set reference4 = part1.CreateReferenceFromBRepName("TgtIntersEdge:(GeneratedEdges;MfIE_R20SP4HFAA;TgtPropagationFillet;FirstOperands:(Remove.1);SecondOperands:();InitEdges:(REdge:(Edge:(Face:(Brp:(Solid.5;%3);None:();Cf11:());Face:(Brp:(Solid.6;%24);None:();Cf11:());None:(Limits1:();Limits2:());Cf11:());WithTemporaryBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)))", remove1)

constRadEdgeFillet1.AddObjectToFillet reference4

constRadEdgeFillet1.EdgePropagation = catTangencyFilletEdgePropagation

Dim reference5 As reference
Set reference5 = part1.CreateReferenceFromBRepName("TgtIntersEdge:(GeneratedEdges;MfIE_R20SP4HFAA;TgtPropagationFillet;FirstOperands:(Remove.1);SecondOperands:();InitEdges:(REdge:(Edge:(Face:(Brp:(Solid.5;%3);None:();Cf11:());Face:(Brp:(Solid.6;%27);None:();Cf11:());None:(Limits1:();Limits2:());Cf11:());WithTemporaryBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)))", remove1)

constRadEdgeFillet1.AddObjectToFillet reference5

constRadEdgeFillet1.EdgePropagation = catTangencyFilletEdgePropagation

part1.UpdateObject constRadEdgeFillet1

part1.Update

End Sub

在此处输入图片描述