错误原因 #

For Each swEdge In edges触发"Object required"错误，核心原因是edges变量未被正确赋值为有效的Edge对象数组，具体可能包括：

• swFeature1.GetBody未成功获取到实体（比如导入特征包含多个实体时，GetBody仅返回第一个实体，若为空则后续数组无效）
• 实体swBody没有可遍历的边（极少发生，但需验证）
• 变量类型不匹配，edges作为Variant未正确接收Edge数组

修复后的关键代码片段 #

Sub CreateDefects()
    Dim swBody As SldWorks.Body2
    Dim swEdge As SldWorks.Edge
    Dim swFeature1 As SldWorks.Feature
    Dim swModel As SldWorks.ModelDoc2
    Dim edgeFound As Boolean
    Dim edgePoint As Variant
    Dim edgeDirection As Variant
    Dim swApp As SldWorks.SldWorks ' 补充缺失的变量声明
    Dim swFeatureMgr As SldWorks.FeatureManager
    Dim swSketchMgr As SldWorks.SketchManager
    Dim swSketchSegment As SldWorks.SketchSegment
    Dim swDim As SldWorks.Dimension
    Dim bool As Boolean
    Dim boolstatus As Boolean
    Dim width As Double, length As Double ' 补充尺寸变量声明
    Dim j As Integer ' 补充变量j声明
    
    ' 初始化SolidWorks应用
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    If swModel Is Nothing Then
        MsgBox "未找到激活文档。"
        Exit Sub
    End If
    Set swFeatureMgr = swModel.FeatureManager

    ' 获取实体（改用GetBodies确保获取有效实体）
    Set swFeature1 = swModel.FeatureByName("Imported1")
    edgeFound = False
    Dim bodies As Variant
    bodies = swFeature1.GetBodies(swBodyType_e.swSolidBody) ' 指定获取实体类型
    If IsEmpty(bodies) Then
        MsgBox "未找到导入的实体。"
        Exit Sub
    End If
    Set swBody = bodies(0) ' 取第一个实体
    
    ' 验证实体有效性
    If swBody Is Nothing Or Not swBody.IsSolid Then
        MsgBox "无效的实体。"
        Exit Sub
    End If

    ' 遍历边查找目标边
    Dim edges As Variant
    edges = swBody.GetEdges
    If Not IsEmpty(edges) Then ' 先检查数组是否为空
        For Each swEdge In edges
            edgePoint = swEdge.GetStartVertex.GetPoint
            edgeDirection = swEdge.GetCurve.GetDirection
            ' 此处可添加边识别逻辑（如根据方向、位置筛选）
            edgeFound = True
            Exit For
        Next swEdge
    End If
        
    If Not edgeFound Then
        MsgBox "未找到目标边。"
        Exit Sub
    End If
    
    ' 获取基准面（需替换为实际基准面名称）
    Dim swRefPlaneFeature As SldWorks.Feature
    Set swRefPlaneFeature = swModel.FeatureByName("你的基准面名称")
    bool = swRefPlaneFeature.Select2(False, 0)
    If bool = False Then
        MsgBox "未找到基准面，请确认基准面存在。" & j
        Exit Sub
    End If

    ' 在基准面上创建草图
    Set swSketchMgr = swModel.SketchManager
    swSketchMgr.InsertSketch True

    ' 绘制中心矩形（需赋值实际尺寸）
    width = 10 ' 示例尺寸，替换为实际值
    length = 20 ' 示例尺寸，替换为实际值
    Set swSketchSegment = swSketchMgr.CreateCenterRectangle(0, 0, 0, width / 2, length / 2, 0)

    ' 直接通过Edge对象选择边，避免坐标误差
    boolstatus = swEdge.Select4(False, Nothing)
    If Not boolstatus Then
        MsgBox "无法选择标注用的边。"
        Exit Sub
    End If

    ' 添加边到矩形中心的线性尺寸
    swModel.Extension.SelectByID2("", "SKETCHPOINT", 0, 0, 0, True, 0, Nothing, 0) ' 加选矩形中心点
    Set swDim = swModel.AddDimension2(0, 0, 0.05)

    ' 添加边与矩形边的角度尺寸
    boolstatus = swSketchSegment.GetFirstEdge.Select4(False, Nothing)
    If boolstatus Then
        Set swDim = swModel.AddDimension2(0.05, 0, 0.05)
    End If

    ' 退出草图
    swSketchMgr.InsertSketch False

End Sub

关键修改点说明 #

• 补充缺失变量声明：原代码中swApp、swFeatureMgr等变量未声明，易引发类型错误
• 改用GetBodies获取实体：GetBody仅返回单个实体，GetBodies可确保获取所有实体，避免空值
• 增加数组空值检查：遍历边前验证edges数组有效性，防止循环空对象
• 改用Select4选择边：避免SelectByID2依赖坐标的不确定性，直接通过Edge对象选择更可靠
• 修复未定义变量：补充width、length、j等变量的声明与赋值，避免运行时错误

额外建议 #

• 边识别逻辑：原代码直接取第一条边，建议添加基于几何特征的筛选（如判断边的方向是否与中心轴垂直、位置是否在斜面上），确保选到目标边
• 草图尺寸：添加尺寸时明确选择对应的草图元素，避免依赖坐标点导致的尺寸位置错误

内容的提问来源于stack exchange，提问作者FerryBoat