|
|
经典图书
'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
'---------------------------------------
复制代码
Dim swSpp As SldWorks.SldWorks
Dim swFoc As SldWorks.ModelDoc2
Dim swFwg As SldWorks.DrawingDoc
Dim swDispDim As SldWorks.DisplayDimension
Dim SwDim As SldWorks.Dimension
Dim swView As SldWorks.View
Sub main()
Set swApp = Application.SldWorks
Set swdoc = swApp.ActiveDoc
Set swdwg = swdoc
Set swView = swdwg.GetFirstView
While Not swView Is Nothing
Set swDispDim = swView.GetFirstDisplayDimension5
While Not swDispDim Is Nothing
Set SwDim = swDispDim.GetDimension
With SwDim
Debug.Print .Name, .FullName, .Value
End With
swDispDim.CenterText = True
Set swDispDim = swDispDim.GetNext5
Wend
Set swView = swView.GetNextView
Wend
End Sub
复制代码
Sub ll()
Dim oDim As Dimension, SwPart As ModelDoc2
Dim DispDim As DisplayDimension
Dim SwApp As SldWorks.SldWorks, SwDraw As DrawingDoc
Set SwApp = Application.SldWorks
Set SwDraw = SwApp.ActiveDoc
With SwDraw
Set oDim = .Parameter("D5@Sketch@Web.Part")
''Set oDim = .Parameter("Ddd@Sketch@Web.Part")
'Set oDim = .Parameter("D1@eDist@JB4712-S.Assembly")
Debug.Print oDim.Name
With oDim
.Name = "Ddd"
End With
End With
End Sub
复制代码
'Iterate Through Dimensions in Model Example (VB)
'This example shows how to iterate through the dimensions in a model. It assumed that you have an active model document.
'--------------------------------------------------
Option Explicit
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swFeat As SldWorks.Feature
Dim swSubFeat As SldWorks.Feature
Dim swDispDim As SldWorks.DisplayDimension
Dim swDim As SldWorks.Dimension
Dim swAnn As SldWorks.Annotation
Dim bRet As Boolean
Set swApp = CreateObject("SldWorks.Application")
Set swModel = swApp.ActiveDoc
Set swFeat = swModel.FirstFeature
Debug.Print "File = " & swModel.GetPathName
Do While Not swFeat Is Nothing
Debug.Print " " + swFeat.Name
Set swSubFeat = swFeat.GetFirstSubFeature
Do While Not swSubFeat Is Nothing
Debug.Print " " + swSubFeat.Name
Set swDispDim = swSubFeat.GetFirstDisplayDimension
Do While Not swDispDim Is Nothing
Set swAnn = swDispDim.GetAnnotation
Set swDim = swDispDim.GetDimension
Debug.Print " [" & swDim.FullName & "] = " & swDim.GetSystemValue2("")
Set swDispDim = swSubFeat.GetNextDisplayDimension(swDispDim)
Loop
Set swSubFeat = swSubFeat.GetNextSubFeature
Loop
Set swDispDim = swFeat.GetFirstDisplayDimension
Do While Not swDispDim Is Nothing
Set swAnn = swDispDim.GetAnnotation
Set swDim = swDispDim.GetDimension
Debug.Print " [" & swDim.FullName & "] = " & swDim.GetSystemValue2("")
Set swDispDim = swFeat.GetNextDisplayDimension(swDispDim)
Loop
Set swFeat = swFeat.GetNextFeature
Loop
End Sub
'--------------------------------------------------
复制代码 |
|
发表于 2012-11-29 22:31:44
QQ好友和群
QQ空间
腾讯微博
腾讯朋友
收藏
转播
教程|习题|模型|技巧
点赞
拍砖
鲁公网安备 37028502190335号