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

 找回密码
 立即注册

QQ登录

只需一步,快速开始

查看: 958|回复: 7
打印 上一主题 下一主题

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

[复制链接]

11

主题

232

帖子

35

金币

侠客

Rank: 3Rank: 3Rank: 3

积分
293
QQ
跳转到指定楼层
楼主
发表于 2011-8-31 08:30:21 | 只看该作者 |只看大图 回帖奖励 |倒序浏览 |阅读模式

   经典图书
花了n天时间,总算初步理解AssemblyDoc::EditMate2的用法.
要当高手,只能用E文消化理解帮助文件中的这些内容.
分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏 转播转播 分享教程|习题|模型|技巧 点赞点赞19582 拍砖拍砖4191
SolidWorks机械工程师网
提示:建议使用谷歌浏览器浏览本网站!如单击这里下载!否则,可能无法下载附件文件!(支持大多数版本的谷歌浏览器,支持360和QQ浏览器的极速模式,即谷歌内核模式,使用IE和Edge浏览器,浏览个别网页以及下载文件时,会误报“***不安全”,此时需要单击“继续访问此不安全站点(不推荐)”才可以继续下载,另外,本网站不含任何不安全的文件,已联系微软公司解决,纯属IE和Edge浏览器误报)
回复

使用道具 举报

80

主题

281

帖子

258

金币

堂主

Rank: 4

积分
539
沙发
发表于 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 "File = " & 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机械工程师网
提示:建议使用谷歌浏览器浏览本网站!如单击这里下载!否则,可能无法下载附件文件!(支持大多数版本的谷歌浏览器,支持360和QQ浏览器的极速模式,即谷歌内核模式,使用IE和Edge浏览器,浏览个别网页以及下载文件时,会误报“***不安全”,此时需要单击“继续访问此不安全站点(不推荐)”才可以继续下载,另外,本网站不含任何不安全的文件,已联系微软公司解决,纯属IE和Edge浏览器误报)
回复 支持 反对

使用道具 举报

11

主题

220

帖子

31

金币

侠客

Rank: 3Rank: 3Rank: 3

积分
270
QQ
板凳
发表于 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
SolidWorks机械工程师网
回复 支持 反对

使用道具 举报

11

主题

214

帖子

36

金币

侠客

Rank: 3Rank: 3Rank: 3

积分
262
QQ
地板
发表于 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
SolidWorks机械工程师网
回复 支持 反对

使用道具 举报

15

主题

207

帖子

29

金币

侠客

Rank: 3Rank: 3Rank: 3

积分
236
5#
发表于 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

复制代码
SolidWorks机械工程师网
回复 支持 反对

使用道具 举报

8

主题

243

帖子

53

金币

侠客

Rank: 3Rank: 3Rank: 3

积分
312
QQ
6#
发表于 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

复制代码
SolidWorks机械工程师网
回复 支持 反对

使用道具 举报

11

主题

231

帖子

23

金币

侠客

Rank: 3Rank: 3Rank: 3

积分
281
QQ
7#
发表于 2011-8-31 08:50:22 | 只看该作者

   经典案例图书
楼主好强悍.....  这些对俺来说是 天书
SolidWorks机械工程师网
回复 支持 反对

使用道具 举报

89

主题

327

帖子

179

金币

堂主

Rank: 4

积分
525
QQ
8#
发表于 2011-8-31 08:52:22 | 只看该作者
收藏,学习一下。
SolidWorks机械工程师网
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

关闭 卷起
关闭 卷起

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

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

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

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

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