几何尺寸与公差论坛------致力于产品几何量公差标准GD&T (GDT:ASME)|New GPS(ISO)研究/CAD设计/CAM加工/CMM测量  


返回   几何尺寸与公差论坛------致力于产品几何量公差标准GD&T (GDT:ASME)|New GPS(ISO)研究/CAD设计/CAM加工/CMM测量 » 仿射空间:CAX软件开发(三)二次开发与程序设计 » CAD二次开发 » SolidWorks二次开发
用户名
密码
注册 帮助 会员 日历 银行 搜索 今日新帖 标记论坛为已读


 
 
主题工具 搜索本主题 显示模式
旧 2008-03-23, 08:41 AM   #1
huangyhg
超级版主
 
huangyhg的头像
 
注册日期: 04-03
帖子: 18592
精华: 36
现金: 249466 标准币
资产: 1080358888 标准币
huangyhg 向着好的方向发展
默认 Get Display Dimensions, GTols, and Surface-Finish Symbols Example (VB)

This example shows how to get all of the displayed dimensions, GTols, and surface-finish symbols.



'-----------------------------------------------

'

' Preconditions: Part, assembly, or drawing document is open.

'

' Postconditions: None

'

'-----------------------------------------------

Option Explicit

Sub ProcessAnnotation _

( _

swApp As SldWorks.SldWorks, _

swAnn As SldWorks.Annotation _

)

Dim swAnnCThread As SldWorks.CThread

Dim swAnnDatumTag As SldWorks.DatumTag

Dim swAnnDatumTargetSym As SldWorks.DatumTargetSym

Dim swAnnDisplayDimension As SldWorks.DisplayDimension

Dim swAnnGTol As SldWorks.Gtol

Dim swAnnNote As SldWorks.note

Dim swAnnSFSymbol As SldWorks.SFSymbol

Dim swAnnWeldSymbol As SldWorks.WeldSymbol

Dim swAnnCustomSymbol As SldWorks.CustomSymbol

Dim swAnnDowelSym As SldWorks.DowelSymbol

Dim swAnnLeader As SldWorks.MultiJogLeader

Dim swAnnCenterMarkSym As SldWorks.CenterMark

Dim swAnnTable As SldWorks.TableAnnotation

Dim swAnnCenterLine As SldWorks.CenterLine

Dim swAnnDatumOrigin As SldWorks.DatumOrigin



Select Case swAnn.GetType

Case swCThread

Set swAnnCThread = swAnn.GetSpecificAnnotation

Debug.Print " swCThread"



Case swDatumTag

Set swAnnDatumTag = swAnn.GetSpecificAnnotation

Debug.Print " swDatumTag"



Case swDatumTargetSym

Set swAnnDatumTargetSym = swAnn.GetSpecificAnnotation

Debug.Print " swDatumTargetSym"



Case swDisplayDimension

Set swAnnDisplayDimension = swAnn.GetSpecificAnnotation

Debug.Print " swDisplayDimension"



Case swGTol

Set swAnnGTol = swAnn.GetSpecificAnnotation

Debug.Print " swGTol"



Case swNote

Set swAnnNote = swAnn.GetSpecificAnnotation

Debug.Print " swNote"



Case swSFSymbol

Set swAnnSFSymbol = swAnn.GetSpecificAnnotation

Debug.Print " swSFSymbol"



Case swWeldSymbol

Set swAnnWeldSymbol = swAnn.GetSpecificAnnotation

Debug.Print " swWeldSymbol"



Case swCustomSymbol

Set swAnnCustomSymbol = swAnn.GetSpecificAnnotation

Debug.Print " swCustomSymbol"



Case swDowelSym

Set swAnnDowelSym = swAnn.GetSpecificAnnotation

Debug.Print " swDowelSym"



Case swLeader

Set swAnnLeader = swAnn.GetSpecificAnnotation

Debug.Print " swLeader"



Case swCenterMarkSym

Set swAnnCenterMarkSym = swAnn.GetSpecificAnnotation

Debug.Print " swCenterMarkSym"



Case swTableAnnotation

Set swAnnTable = swAnn.GetSpecificAnnotation

Debug.Print " swTableAnnotation"



Case swCenterLine

Set swAnnCenterLine = swAnn.GetSpecificAnnotation

Debug.Print " swCenterLine"



Case swDatumOrigin

Set swAnnDatumOrigin = swAnn.GetSpecificAnnotation

Debug.Print " swDatumOrigin"



Case Else

Debug.Print " Unknown annotation type"

Debug.Assert False

End Select

End Sub

Sub ProcessModel _

( _

swApp As SldWorks.SldWorks, _

swModel As SldWorks.ModelDoc2, _

nLevel As Long _

)

Dim swAnn As SldWorks.Annotation

Dim nNumLeader As Long

Dim nNumPts As Long

Dim vLeaderPt As Variant



Dim sPadSpace As String

Dim i As Long

Dim j As Long

Dim bRet As Boolean





For i = 0 To nLevel

sPadSpace = sPadSpace & " "

Next i



Debug.Print sPadSpace & swModel.GetPathName



Set swAnn = swModel.GetFirstAnnotation2



Do While Not swAnn Is Nothing

Debug.Print sPadSpace & " " & swAnn.GetName & " [" & swAnn.GetType & "]"



If True = swAnn.GetLeader Then

For i = 0 To swAnn.GetLeaderCount - 1

If True = swAnn.GetBentLeader Then

nNumPts = 3

Else

nNumPts = 2

End If



vLeaderPt = swAnn.GetLeaderPointsAtIndex(i)

For j = 0 To nNumPts - 1

Debug.Print sPadSpace & " Pt[" & Str(i) & "] = (" & _

Str(vLeaderPt(3 * j & 0)) & "," & _

Str(vLeaderPt(3 * j & 1)) & "," & _

Str(vLeaderPt(3 * j & 2)) & ")"

Next j

Next i

End If

Debug.Print ""

ProcessAnnotation swApp, swAnn



Set swAnn = swAnn.GetNext3

Loop

End Sub

Sub ProcessComponent _

( _

swApp As SldWorks.SldWorks, _

swComp As SldWorks.Component2, _

nLevel As Long _

)

Dim vChildArray As Variant

Dim swChildComp As SldWorks.Component2

Dim swModel As SldWorks.ModelDoc2

Dim swPart As SldWorks.PartDoc

Dim i As Long



nLevel = nLevel & 1

vChildArray = swComp.GetChildren



For i = 0 To UBound(vChildArray)

Set swChildComp = vChildArray(i)

ProcessComponent swChildComp, nLevel

Next i



Set swModel = swComp.GetModelDoc



If Not swModel Is Nothing Then

If swDocPART = swModel.GetType Then

ProcessModel swModel, nLevel

End If

End If

End Sub

Sub ProcessDrawing _

( _

swApp As SldWorks.SldWorks, _

swDraw As SldWorks.DrawingDoc _

)

Dim swView As SldWorks.View

Dim swAnn As SldWorks.Annotation



Set swView = swDraw.GetFirstView

Do While Not Nothing Is swView

Set swAnn = swView.GetFirstAnnotation3

Do While Not Nothing Is swAnn

ProcessAnnotation swApp, swAnn



Set swAnn = swAnn.GetNext3

Loop

Set swView = swView.GetNextView

Loop

End Sub

Sub main()

Dim swApp As SldWorks.SldWorks

Dim swModel As SldWorks.ModelDoc2

Dim swAssy As SldWorks.AssemblyDoc

Dim swDraw As SldWorks.DrawingDoc

Dim swConfig As SldWorks.configuration

Dim swConfigMgr As SldWorks.ConfigurationMgr

Dim swRootComp As SldWorks.Component2

Dim nStatus As Long

Dim bRet As Boolean



Set swApp = Application.SldWorks

Set swModel = swApp.ActiveDoc



Select Case swModel.GetType

Case swDocPART

ProcessModel swApp, swModel, 0



Case swDocASSEMBLY

Set swAssy = swModel

nStatus = swAssy.ResolveAllLightWeightComponents(False)

Set swConfigMgr = swModel.ConfigurationManager

Set swConfig = swConfigMgr.ActiveConfiguration

Set swRootComp = swConfig.GetRootComponent



ProcessComponent swApp, swRootComp, 0



Case swDocDRAWING

Set swDraw = swModel



ProcessDrawing swApp, swDraw



Case Else

Exit Sub

End Select

End Sub

'-----------------------------------------------
huangyhg离线中   回复时引用此帖
GDT自动化论坛(仅游客可见)
 


主题工具 搜索本主题
搜索本主题:

高级搜索
显示模式

发帖规则
不可以发表新主题
不可以回复主题
不可以上传附件
不可以编辑您的帖子

vB 代码开启
[IMG]代码开启
HTML代码关闭



所有的时间均为北京时间。 现在的时间是 02:03 PM.


于2004年创办,几何尺寸与公差论坛"致力于产品几何量公差标准GD&T | GPS研究/CAD设计/CAM加工/CMM测量"。免责声明:论坛严禁发布色情反动言论及有关违反国家法律法规内容!情节严重者提供其IP,并配合相关部门进行严厉查处,若內容有涉及侵权,请立即联系我们QQ:44671734。注:此论坛须管理员验证方可发帖。
沪ICP备06057009号-2
更多