设为首页收藏本站
开启辅助访问

SolidWorks机械工程师网——最大的SolidWorks学习平台

 找回密码
 立即注册

QQ登录

只需一步，快速开始

SolidWorks机械工程师网——最大的SolidWorks学习平台»学习社区 › SolidWorks开发与拓展应用 › SolidWorks二次开发（宏，VBA） › 帮助文件Edit→是当API高手要点之一.

帮助文件Edit→是当API高手要点之一.

查看数: 963 | 评论数: 7 | 收藏 0
关灯 | 提示：支持键盘翻页<-左 右->
帖子模式
    组图打开中，请稍候......
qgbob
发布时间: 2011-8-31 08:30

正文摘要:

花了n天时间,总算初步理解AssemblyDoc::EditMate2的用法. 要当高手,只能用E文消化理解帮助文件中的这些内容.

回复

383082654 发表于 2011-8-31 08:52:22
收藏，学习一下。
keita374 发表于 2011-8-31 08:50:22
楼主好强悍.....  这些对俺来说是 天书
怒放 发表于 2011-8-31 08:49:29


    ' Preconditions:
    '           (1) Part document is open and contains
    '               sketch text.
    '           (2) Feature for sketch text is selected.'
    ' Postconditions: Original sketch text is replaced with
    '           new sketch text, &quot;New text&quot;.'
    '-------------------------------
    Option Explicit
    Dim swApp As SldWorks.SldWorks
    Dim swModel As Object
    Dim swSelMgr As SldWorks.SelectionMgr
    Dim swFeat As SldWorks.Feature
    Dim swSketch As SldWorks.Sketch
    Dim swSketchText As SldWorks.SketchText
    Dim params As Variant

    Sub main()
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swSelMgr = swModel.SelectionManager
    ' Get the selected feature of the sketch text
    Set swFeat = swSelMgr.GetSelectedObject6(1, 0)
    Set swSketch = swFeat.GetSpecificFeature2
    ' Edit the sketch of the sketch text
    swModel.EditSketch
    ' Get the sketch text
    params = swSketch.GetSketchTextSegments
    ' Only one instance of sketch text so
    ' set SketchText to that instance
    Set swSketchText = params(0)
    ' Print the current sketched text
    Debug.Print swSketchText.Text
    'Change the sketched text
    swSketchText.Text = &quot;New text&quot;
    ' Print the changed text
    Debug.Print swSketchText.Text
    ' Insert the new text in the sketch,
    ' rebuild the part with any changes
    ' made to the sketch, and
    ' exit sketch mode
    swModel.InsertSketch2 True
    End Sub

复制代码
孟眉 发表于 2011-8-31 08:48:22


    Const swTnProfileFeature        As String = &quot;ProfileFeature&quot;
    Const nTolerance                As Double = 0.00000001
    Sub FindAllUnderConstrainedSketches _
    ( _
        swApp As SldWorks.SldWorks, _
        swModel As SldWorks.ModelDoc2, _
        sSketchNameArr() As String _
    )
        Dim swPart                          As SldWorks.PartDoc
        Dim swFeat                          As SldWorks.Feature
        Dim swSketch                        As SldWorks.Sketch
        Dim bRet                            As Boolean
        Set swPart = swModel
        Set swFeat = swPart.FirstFeature
        Do While Not swFeat Is Nothing
            If swTnProfileFeature = swFeat.GetTypeName Then
                Set swSketch = swFeat.GetSpecificFeature2
                If swUnderConstrained = swSketch.GetConstrainedStatus Then
                    sSketchNameArr(UBound(sSketchNameArr)) = swFeat.Name
                    ReDim Preserve sSketchNameArr(UBound(sSketchNameArr) + 1)
                End If
            End If
            Set swFeat = swFeat.GetNextFeature
        Loop
        ' Remove last empty sketch name
        ReDim Preserve sSketchNameArr(UBound(sSketchNameArr) - 1)
    End Sub
    Function GetAllSketchLines( _
        swApp As SldWorks.SldWorks, _
        swModel As SldWorks.ModelDoc2, _
        swSketch As SldWorks.Sketch) As Variant
        Dim vSketchSegArr                   As Variant
        Dim vSketchSeg                      As Variant
        Dim swSketchSeg                     As SldWorks.SketchSegment
        Dim swSketchCurrLine                As SldWorks.SketchLine
        Dim swSketchLineArr()               As SldWorks.SketchLine
        ReDim swSketchLineArr(0)
        vSketchSegArr = swSketch.GetSketchSegments
        If Not IsEmpty(vSketchSegArr) Then
            For Each vSketchSeg In vSketchSegArr
                Set swSketchSeg = vSketchSeg
                If swSketchLINE = swSketchSeg.GetType Then
                    Set swSketchCurrLine = swSketchSeg
                    Set swSketchLineArr(UBound(swSketchLineArr)) = swSketchCurrLine
                    ReDim Preserve swSketchLineArr(UBound(swSketchLineArr) + 1)
                End If
            Next
        End If
        If 0 = UBound(swSketchLineArr) Then
            ' No straight lines in this sketch
            GetAllSketchLines = Empty
            Exit Function
        End If
        ' Remove last empty sketch line
        ReDim Preserve swSketchLineArr(UBound(swSketchLineArr) - 1)
        GetAllSketchLines = swSketchLineArr
    End Function
    Function GetSketchPoint( _
        swApp As SldWorks.SldWorks, _
        swModel As SldWorks.ModelDoc2, _
        swSketch As SldWorks.Sketch, _
        swSketchPt As SldWorks.SketchPoint) As Boolean
        Dim vSketchPtArr                    As Variant
        vSketchPtArr = swSketch.GetSketchPoints
        If Not IsEmpty(vSketchPtArr) Then
            ' Use first point
            Set swSketchPt = vSketchPtArr(0)
            GetSketchPoint = True
            Exit Function
        End If
        GetSketchPoint = False
    End Function
    Function FindVerticalOrigin( _
        swApp As SldWorks.SldWorks, _
        swModel As SldWorks.ModelDoc2, _
        swSketch As SldWorks.Sketch, _
        swSketchSegVert As SldWorks.SketchSegment, _
        swSketchPtVert As SldWorks.SketchPoint) As Boolean
        Dim vSketchLineArr                  As Variant
        Dim vSketchLine                     As Variant
        Dim swSketchCurrLine                As SldWorks.SketchLine
        Dim swStartPt                       As SldWorks.SketchPoin
        Dim swEndPt                         As SldWorks.SketchPoint
        ' Try to get first vertical line
        vSketchLineArr = GetAllSketchLines(swApp, swModel, swSketch)
        If Not IsEmpty(vSketchLineArr) Then
            For Each vSketchLine In vSketchLineArr
                Set swSketchCurrLine = vSketchLine
                Set swStartPt = swSketchCurrLine.GetStartPoint2
                Set swEndPt = swSketchCurrLine.GetEndPoint2
                If Abs(swStartPt.X - swEndPt.X) < nTolerance Then
                    Set swSketchSegVert = swSketchCurrLine
                    FindVerticalOrigin = True
                    Exit Function
                End If
            Next
        End If
        ' Try to get the first point
        FindVerticalOrigin = GetSketchPoint(swApp, swModel, swSketch, swSketchPtVert)
    End Function
    Function FindHorizontalOrigin( _
        swApp As SldWorks.SldWorks, _
        swModel As SldWorks.ModelDoc2, _
        swSketch As SldWorks.Sketch, _
        swSketchSegHoriz As SldWorks.SketchSegment, _
        swSketchPtHoriz As SldWorks.SketchPoint) As Boolean
        Dim vSketchLineArr                  As Variant
        Dim vSketchLine                     As Variant
        Dim swSketchCurrLine                As SldWorks.SketchLine
        Dim swStartPt                       As SldWorks.SketchPoint
        Dim swEndPt                         As SldWorks.SketchPoint
        ' Try to get first horizontal line
        vSketchLineArr = GetAllSketchLines(swApp, swModel, swSketch)
        If Not IsEmpty(vSketchLineArr) Then
            For Each vSketchLine In vSketchLineArr
                Set swSketchCurrLine = vSketchLine
                Set swStartPt = swSketchCurrLine.GetStartPoint2
                Set swEndPt = swSketchCurrLine.GetEndPoint2
                If Abs(swStartPt.Y - swEndPt.Y) < nTolerance Then
                    Set swSketchSegHoriz = swSketchCurrLine
                    FindHorizontalOrigin = True
                    Exit Function
                End If
            Next
        End If
        ' Try to get the first point
        FindHorizontalOrigin = GetSketchPoint(swApp, swModel, swSketch, swSketchPtHoriz)
    End Function
    Function AutoDimensionSketch( _
        swApp As SldWorks.SldWorks, _
        swModel As SldWorks.ModelDoc2, _
        swSketch As SldWorks.Sketch) As Long
        Dim swFeat                          As SldWorks.Feature
        Dim swSketchSegHoriz                As SldWorks.SketchSegment
        Dim swSketchPtHoriz                 As SldWorks.SketchPoint
        Dim swSketchSegVert                 As SldWorks.SketchSegment
        Dim swSketchPtVert                  As SldWorks.SketchPoint
        Dim bRet                            As Boolean
        If False = FindHorizontalOrigin(swApp, swModel, swSketch, swSketchSegHoriz, swSketchPtHoriz) Then
            AutoDimensionSketch = swAutodimStatusDatumLineNotHorizontal
            Exit Function
        End If
        If False = FindVerticalOrigin(swApp, swModel, swSketch, swSketchSegVert, swSketchPtVert) Then
            AutoDimensionSketch = swAutodimStatusDatumLineNotVertical
            Exit Function
        End If
        Set swFeat = swSketch
        bRet = swFeat.Select2(False, 0)
        Debug.Assert bRet
        ' Editing sketch clears selections
        swModel.EditSketch
        ' Reselect sketch segments for autodimensioning
        If Not swSketchSegVert Is Nothing Then
            ' Vertical line is for horizontal datum
            bRet = swSketchSegVert.Select4(True, Nothing)
        ElseIf Not swSketchPtHoriz Is Nothing Then
                 bRet = swSketchPtHoriz.Select4(True, Nothing)
        ElseIf Not swSketchPtVert Is Nothing Then
                ' Use any sketch point for horizontal datum
                 bRet = swSketchPtVert.Select4(True, Nothing)
        End If
        Debug.Assert bRet
        If Not swSketchSegHoriz Is Nothing Then
            ' Horizontal line is for vertical datum
            bRet = swSketchSegHoriz.Select4(True, Nothing)
        ElseIf Not swSketchPtVert Is Nothing Then
            bRet = swSketchPtVert.Select4(True, Nothing)
        ElseIf Not swSketchPtHoriz Is Nothing Then
                ' Use any sketch point for vertical datum
                bRet = swSketchPtHoriz.Select4(True, Nothing)
        End If
        Debug.Assert bRet
        ' No straight lines, probably contains circles,
        ' so use sketch points for datums
        If IsEmpty(GetAllSketchLines(swApp, swModel, swSketch)) Then
            If Not swSketchPtHoriz Is Nothing Then
                bRet = swSketchPtHoriz.Select4(False, Nothing)
            ElseIf Not swSketchPtVert Is Nothing Then
                bRet = swSketchPtVert.Select4(False, Nothing)
            End If
        End If
        Debug.Assert bRet
        AutoDimensionSketch = swSketch.AutoDimension2(swAutodimEntitiesAll, _
                                swAutodimSchemeBaseline, _
                                swAutodimHorizontalPlacementBelow, _
                                swAutodimSchemeBaseline, _
                                swAutodimVerticalPlacementLeft)
        ' Redraw so dimensions are displayed immediately
        swModel.GraphicsRedraw2
        ' Exit sketch edit
        ' Leave rebuild to later
        swModel.InsertSketch2 False
    End Function
    Sub main()
        Dim swApp                           As SldWorks.SldWorks
        Dim swModel                         As SldWorks.ModelDoc2
        Dim swPart                          As SldWorks.PartDoc
        Dim sSketchNameArr()                As String
        Dim sSketchName                     As Variant
        Dim swFeat                          As SldWorks.Feature
        Dim swSketch                        As SldWorks.Sketch
        Dim nRetVal                         As Long
        Dim i                               As Long
        Dim bRet                            As Boolean
        Set swApp = CreateObject(&quot;SldWorks.Application&quot;)
        Set swModel = swApp.ActiveDoc
        Set swPart = swModel
        Debug.Print &quot;File = &quot; & swModel.GetPathName
        ReDim sSketchNameArr(0)
        FindAllUnderConstrainedSketches swApp, swModel, sSketchNameArr
        For Each sSketchName In sSketchNameArr
            Set swFeat = swPart.FeatureByName(sSketchName)
            Set swSketch = swFeat.GetSpecificFeature
            nRetVal = AutoDimensionSketch(swApp, swModel, swSketch)
            Debug.Print &quot;  &quot; & sSketchName & &quot; = &quot; & nRetVal
        Next
        ' Rebuild after modifying sketches
        bRet = swModel.EditRebuild3
        Debug.Assert bRet
    End Sub

复制代码
tobybird 发表于 2011-8-31 08:44:20
' Preconditions:
'       (1) Assembly is open.
'       (2) Assembly is fully resolved.
'       (3) Component is selected.'
' Postconditions: Plane, passing through three points,
'                 is created in the selected component.
'----------------------------------------
Option Explicit
Sub main()
    Dim swApp                   As SldWorks.SldWorks
    Dim swModel                 As SldWorks.ModelDoc2
    Dim swAssy                  As SldWorks.AssemblyDoc
    Dim swEditModel             As SldWorks.ModelDoc2
    Dim swSelMgr                As SldWorks.SelectionMgr
    Dim swSelData               As SldWorks.SelectData
    Dim swPart                  As SldWorks.PartDoc
    Dim swSketchPt1             As SldWorks.SketchPoint
    Dim swSketchPt2             As SldWorks.SketchPoint
    Dim swSketchPt3             As SldWorks.SketchPoint
    Dim swPlane                 As SldWorks.RefPlane
    Dim nRetVal                 As Long
    Dim nInfo                   As Long
    Dim bRet                    As Boolean
    Set swApp = CreateObject(&quot;SldWorks.Application&quot;)
    Set swModel = swApp.ActiveDoc
    Set swSelMgr = swModel.SelectionManager
    Set swSelData = swSelMgr.CreateSelectData
    Set swAssy = swModel
    ' start in-context edit
    nRetVal = swAssy.EditPart2(True, False, nInfo)
    Debug.Assert swEditPartSuccessful = nRetVal
    Set swEditModel = swModel
    ' Turn off snapping
    swEditModel.SetAddToDB True
    ' Insert part/component 3D sketch in-context
    swEditModel.Insert3DSketch2 True
    ' Create points in part
    Set swSketchPt1 = swEditModel.CreatePoint2(0#, 0.02123307340457, 0.005485856156458)
    Set swSketchPt2 = swEditModel.CreatePoint2(0.04415646169588, 0.01166034702997, -0.00770979679615)
    Set swSketchPt3 = swEditModel.CreatePoint2(0#, -0.006247647329005, 0.007641244473859)
    ' Exit sketch but in assembly
    ' This gets you to editing part/component in-context
    swModel.Insert3DSketch2 True
    ' Restore snapping
    swEditModel.SetAddToDB False
    swModel.ClearSelection2 True
    bRet = swSketchPt1.Select4(True, swSelData): Debug.Assert bRet
    bRet = swSketchPt2.Select4(True, swSelData): Debug.Assert bRet
    bRet = swSketchPt3.Select4(True, swSelData): Debug.Assert bRet
    ' Create plane in part/component
    Set swPlane = swModel.CreatePlaneThru3Points3(True)
    Debug.Assert Not swPlane Is Nothing
    ' Go back to assembly
    ' End in-context edit
    swAssy.EditAssembly
End Sub
魑魅魍魉→鑫 发表于 2011-8-31 08:41:52
Dim SwApp As Object
Sub main()
  Dim SwApp As SldWorks.SldWorks, Part As SldWorks.ModelDoc2
  Set SwApp = Application.SldWorks
  Set Part = SwApp.ActiveDoc
  Dim SwSketch As SldWorks.Sketch, oArr
  Dim SelMgr As SelectionMgr
  With Part
    'Set swSketch = .GetActiveSketch2()
    Set SelMgr = .SelectionManager
    boolstatus = .Extension.SelectByID2(&quot;草图1&quot;, &quot;SKETCH&quot;, 0, 0, 0, False, 0, Nothing, 0)
    Set swFeat = SelMgr.GetSelectedObject5(1)
    Set SwSketch = swFeat.GetSpecificFeature
    oArr = SwSketch.GetSketchPoints()
    Debug.Print oArr(1).X
  End With
End Sub
gnwjgecduu 发表于 2011-8-31 08:41:43
  

aa.zip (15.48 KB, 下载次数: 10)
Commponent→直译组成部分,元件.
为了与Part零件区别,在此翻译为组成部分.
Suppress Component Feature Example (VB)→支持零件特征的示例
This example shows how to suppress the selected component feature.
这个示例支持选择组成部分特征.
'------------------------------------------------
' Preconditions: 先决条件
'       (1) Assembly document is open.打开装配文件
'       (2) Component feature is selected in the FeatureManager design tree.在特征管理器的设计树下选择零件特征
' Postconditions: Selected component feature is suppressed.后置条件,选择组成部分特征
' NOTE: Editing a component requires that geometry on
'       the component to be selected.  However, not
'       all features are associated with geometry.
'注意事项:选择需要编辑的零件,不管是否关联几何体.
'       Therefore, it is necessary to select the component
'       before attempting to edit the component.
' 因此,在试图编辑零件前,需要选择零件.
'------------------------------------------------
Option Explicit
'文件类型的枚举类型定义
Public Enum swDocumentTypes_e
    swDocNONE = 0       ' Used to be TYPE_NONE
    swDocPART = 1       ' Used to be TYPE_PART 零件类型
    swDocASSEMBLY = 2   ' Used to be TYPE_ASSEMBLY 装配体类型
    swDocDRAWING = 3    ' Used to be TYPE_DRAWING  图纸类型
End Enum
'  Possible status values for AssemblyDoc::EditPart2  用于AssemblyDoc状态值→EditPart2
'编辑零件组成部分状态'
Public Enum swEditPartCommandStatus_e
    swEditPartFailure = -1
    swEditPartAsmMustBeSaved = -2
    swEditPartCompMustBeSelected = -3
    swEditPartCompMustBeResolved = -4  '必须是等待返测值
    swEditPartCompMustHaveWriteAccess = -5 '必须有写存取
    swEditPartSuccessful = 0
    swEditPartCompNotPositioned = &H1 '比较位置
End Enum
Sub main()
    Dim swApp               As SldWorks.SldWorks
    Dim swModel             As SldWorks.ModelDoc2
    Dim swAssy              As SldWorks.AssemblyDoc
    Dim swEditModel         As SldWorks.ModelDoc2
    Dim swEditPart          As SldWorks.PartDoc
    Dim swEditAssy          As SldWorks.AssemblyDoc
    Dim swSelMgr            As SldWorks.SelectionMgr
    Dim swFeat              As SldWorks.feature
    Dim swComp              As SldWorks.Component2
    Dim sFeatName           As String
    Dim nStatus             As Long
    Dim nInfo               As Long
    Dim i                   As Long
    Dim bRet                As Boolean   
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swAssy = swModel
    Set swSelMgr = swModel.SelectionManager
    Set swFeat = swSelMgr.GetSelectedObject5(1): Debug.Assert Not swFeat Is Nothing
    Set swComp = swSelMgr.GetSelectedObjectsComponent2(1): Debug.Assert Not swComp Is Nothing   
    Debug.Print &quot;File = &quot; & swModel.GetPathName
    Debug.Print &quot;    &quot; & swFeat.Name & &quot; <&quot; & swFeat.GetTypeName & &quot;>&quot;
    Debug.Print &quot;&quot;   
    sFeatName = swFeat.Name   
    bRet = swComp.Select2(False, 0): Debug.Assert bRet
    nStatus = swAssy.EditPart2(True, False, nInfo): Debug.Assert swEditPartSuccessful = nStatus   
    Set swEditModel = swAssy.GetEditTarget   
    Select Case swEditModel.GetType
        Case swDocPART
            Set swEditPart = swEditModel
            Set swFeat = swEditPart.FeatureByName(sFeatName): Debug.Assert Not swFeat Is Nothing           
            bRet = swFeat.Select2(False, 0): Debug.Assert bRet      
        Case swDocASSEMBLY
            Set swEditAssy = swEditModel
            Set swFeat = swEditAssy.FeatureByName(sFeatName): Debug.Assert Not swFeat Is Nothing            
            bRet = swFeat.Select2(False, 0): Debug.Assert bRet            
        Case Else
            Debug.Assert False
    End Select        
    ' Try to suppress the selected feature;   
    ' should not assert because feature might not be
    ' able to be suppressed; for example, standard reference plane or
    ' origin
  '尝试选择特征支持将不会得到维护.因为,特征可能不会支持参考平面和参考点.
    bRet = swEditModel.EditSuppress2: Debug.Assert bRet
    swAssy.EditAssembly
End Sub
'------------------------------------------
关闭 卷起
关闭 卷起

SOLIDWORKS 2023 机械设计从入门到精通

手机版|小黑屋| GMT+8, 2024-9-30 11:33 , Processed in 0.176617 second(s), 26 queries , Memcache On.

SolidWorks机械工程师网 ( 鲁ICP备14025122号-2 ) 鲁公网安备 37028502190335号

声明：本网言论纯属发表者个人意见，与本网立场无关。
如涉版权，可发邮件： admin@swbbsc.com

快速回复 返回顶部 返回列表