|
经典图书
在工程图中,遍历尺寸。'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
复制代码 |
|