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

标题: Get Dimension Values in Drawing Example (VB) [打印本页]

---

作者: 上古科技    时间: 2012-11-27 22:08
标题: Get Dimension Values in Drawing Example (VB)
  
在工程图中，遍历尺寸。

'Get Dimension Values in Drawing Example (VB)
'This example shows how to get the values of the dimensions in a drawing.
'----------------------------------------
'
' Preconditions: Drawing document is open.
'
' Postconditions: None
'
'----------------------------------------
Option Explicit
Public Enum swDimensionDrivenState_e
swDimensionDrivenUnknown = 0 ' Driven/driving state is unknown
swDimensionDriven = 1 ' Dimension is a driven dimension
swDimensionDriving = 2 ' Dimension is a driving dimension
End Enum
Public Enum swDimensionArrowsSide_e
swDimArrowsInside = 0 ' Arrows inside of the witness lines
swDimArrowsOutside = 1 ' Arrows outside of the witness lines
swDimArrowsSmart = 2 ' Arrows inside if the text and arrows fit, outside if not
swDimArrowsFollowDoc = 3 ' Arrows the same as the document default for placing arrows
End Enum
Public Enum swDimensionTextParts_e
swDimensionTextAll = 0 ' All pieces of text (used only by SetText)
swDimensionTextPrefix = 1 ' Prefix portion of the text
swDimensionTextSuffix = 2 ' Suffix portion of the text
swDimensionTextCalloutAbove = 3 ' Callout portion of the text, above the dimension
swDimensionTextCalloutBelow = 4 ' Callout portion of the text, below the dimension
End Enum
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Dim swView As SldWorks.View
Dim swDispDim As SldWorks.DisplayDimension
Dim swDim As SldWorks.Dimension
Dim swAnn As SldWorks.Annotation
Dim bRet As Boolean

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swDraw = swModel

Debug.Print "File = " & swModel.GetPathName

Set swView = swDraw.GetFirstView
Do While Not swView Is Nothing
Debug.Print " View = " & swView.Name

Set swDispDim = swView.GetFirstDisplayDimension5
Do While Not swDispDim Is Nothing
Set swAnn = swDispDim.GetAnnotation
Set swDim = swDispDim.GetDimension

Debug.Print " ------------------------------------"

Debug.Print " AnnName = " & swAnn.GetName
Debug.Print " DimFullName = " & swDim.FullName
Debug.Print " DimName = " & swDim.Name
Debug.Print " DrivenState = " & swDim.DrivenState
Debug.Print " ReadOnly = " & swDim.ReadOnly
Debug.Print " Value = " & swDim.GetSystemValue2("")
Debug.Print ""

Debug.Print " Arrowside = " & swDispDim.ArrowSide

Debug.Print " TextAll = " & swDispDim.GetText(swDimensionTextAll)
Debug.Print " TextPrefix = " & swDispDim.GetText(swDimensionTextPrefix)
Debug.Print " TextSuffix = " & swDispDim.GetText(swDimensionTextSuffix)
Debug.Print " CalloutAbove = " & swDispDim.GetText(swDimensionTextCalloutAbove)
Debug.Print " CalloutBelow = " & swDispDim.GetText(swDimensionTextCalloutBelow)

Set swDispDim = swDispDim.GetNext3
Loop
Set swView = swView.GetNextView
Loop
End Sub

复制代码
'---------------------------------------

Sub main1()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Dim swView As SldWorks.View
Dim swDispDim As SldWorks.DisplayDimension
Dim swDim As SldWorks.Dimension
Dim swAnn As SldWorks.Annotation
Dim bRet As Boolean

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swDraw = swModel

Debug.Print "File = " & swModel.GetPathName

Set swView = swDraw.GetFirstView
''
Do While Not swView Is Nothing
Debug.Print " View = " & swView.Name

Set swDispDim = swView.GetFirstDisplayDimension5
Do While Not swDispDim Is Nothing
Set swAnn = swDispDim.GetAnnotation
Set swDim = swDispDim.GetDimension

Debug.Print " ------------------------------------"

Debug.Print " AnnName = " & swAnn.GetName
Debug.Print " DimFullName = " & swDim.FullName

Set swDispDim = swDispDim.GetNext3
Loop
Set swView = swView.GetNextView
Loop
End Sub
'---------------------------------------

复制代码

'------------------------------------------------------------------
'
' Preconditions: An assembly is open.
'
' Postconditions: All sketches in the assembly are hidden.
'
'------------------------------------------------------------------
Option Explicit
Sub BlankSketchFeature _
( _
swApp As SldWorks.SldWorks, _
swModel As SldWorks.ModelDoc2, _
swFeat As SldWorks.Feature _
)
Dim bRet As Boolean

If "ProfileFeature" = swFeat.GetTypeName Then
bRet = swFeat.Select2(False, 0): Debug.Assert bRet

'=====NEW CODE BEGINS=====
Dim swDispDim As DisplayDimension, swAnn As Annotation, swDim As Dimension

'Get first display dimension in this sketch
Set swDispDim = swFeat.GetFirstDisplayDimension

'Traverse dimensions for this sketch
Do While Not swDispDim Is Nothing
Set swAnn = swDispDim.GetAnnotation
Set swDim = swDispDim.GetDimension

Debug.Print " [" & swDim.FullName & "] = " & swDim.Value


Set swDispDim = swFeat.GetNextDisplayDimension(swDispDim)
Loop
'=====NEW CODE ENDS=====

swModel.BlankSketch
End If
End Sub

Sub TraverseFeatureFeatures _
( _
swApp As SldWorks.SldWorks, _
swModel As SldWorks.ModelDoc2, _
swFeat As SldWorks.Feature, _
nLevel As Long _
)
Dim swSubFeat As SldWorks.Feature
Dim swSubSubFeat As SldWorks.Feature
Dim swSubSubSubFeat As SldWorks.Feature
Dim sPadStr As String
Dim i As Long

For i = 0 To nLevel
sPadStr = sPadStr + " "
Next i

Dim bRet As Boolean

If "Annotations"  swFeat.name Then
bRet = swFeat.Select2(True, 0): Debug.Assert bRet
End If
While Not swFeat Is Nothing
Debug.Print sPadStr + swFeat.name + " [" + swFeat.GetTypeName + "]"

BlankSketchFeature swApp, swModel, swFeat

Set swSubFeat = swFeat.GetFirstSubFeature
While Not swSubFeat Is Nothing
Debug.Print sPadStr + " " + swSubFeat.name + " [" + swSubFeat.GetTypeName + "]"

BlankSketchFeature swApp, swModel, swSubFeat

Set swSubSubFeat = swSubFeat.GetFirstSubFeature
While Not swSubSubFeat Is Nothing
Debug.Print sPadStr + " " + swSubSubFeat.name + " [" + swSubSubFeat.GetTypeName + "]"

BlankSketchFeature swApp, swModel, swSubSubFeat

Set swSubSubSubFeat = swSubFeat.GetFirstSubFeature
While Not swSubSubSubFeat Is Nothing
Debug.Print sPadStr + " " + swSubSubSubFeat.name + " [" + swSubSubSubFeat.GetTypeName + "]"

BlankSketchFeature swApp, swModel, swSubSubSubFeat

Set swSubSubSubFeat = swSubSubSubFeat.GetNextSubFeature()
Wend

Set swSubSubFeat = swSubSubFeat.GetNextSubFeature()
Wend

Set swSubFeat = swSubFeat.GetNextSubFeature()
Wend

Set swFeat = swFeat.GetNextFeature
Wend
End Sub

Sub TraverseComponentFeatures _
( _
swApp As SldWorks.SldWorks, _
swModel As SldWorks.ModelDoc2, _
swComp As SldWorks.Component2, _
nLevel As Long _
)
Dim swFeat As SldWorks.Feature

Set swFeat = swComp.FirstFeature

TraverseFeatureFeatures swApp, swModel, swFeat, nLevel
End Sub

Sub TraverseComponent _
( _
swApp As SldWorks.SldWorks, _
swModel As SldWorks.ModelDoc2, _
swComp As SldWorks.Component2, _
nLevel As Long _
)
Dim vChildComp As Variant
Dim swChildComp As SldWorks.Component2
Dim swCompConfig As SldWorks.Configuration
Dim sPadStr As String
Dim i As Long

For i = 0 To nLevel - 1
sPadStr = sPadStr + " "
Next i

vChildComp = swComp.GetChildren
For i = 0 To UBound(vChildComp)
Set swChildComp = vChildComp(i)

Debug.Print sPadStr & "+" & swChildComp.Name2 & " "

TraverseComponentFeatures swApp, swModel, swChildComp, nLevel
TraverseComponent swApp, swModel, swChildComp, nLevel + 1
Next i
End Sub

Sub TraverseModelFeatures _
( _
swApp As SldWorks.SldWorks, _
swModel As SldWorks.ModelDoc2, _
nLevel As Long _
)
Dim swFeat As SldWorks.Feature

Set swFeat = swModel.FirstFeature
TraverseFeatureFeatures swApp, swModel, swFeat, nLevel
End Sub

Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swConf As SldWorks.Configuration
Dim swRootComp As SldWorks.Component2
Dim nStart As Single
Dim bRet As Boolean

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swConf = swModel.GetActiveConfiguration
Set swRootComp = swConf.GetRootComponent

nStart = Timer

Debug.Print "File = " & swModel.GetPathName

TraverseModelFeatures swApp, swModel, 1
TraverseComponent swApp, swModel, swRootComp, 1
Debug.Print ""
Debug.Print "Time = " & Timer - nStart & "s"
End Sub

复制代码

---

作者: jyzas001    时间: 2017-8-12 11:51
谢谢楼主分享

---

欢迎光临 SolidWorks机械工程师网——最大的SolidWorks学习平台 (https://www.swbbsc.com/)

Powered by Discuz! X3.2