|
- Private Sub ViewToRng()
- Dim SwApp As SldWorks.SldWorks, SwModel As ModelDoc2
- Set SwApp = Application.SldWorks
- Set SwModel = SwApp.ActiveDoc
- Dim SwDraw As DrawingDoc
- Set SwDraw = SwModel
- Dim SwFeat As Feature, SwSubFeat As Feature
- Set SwFeat = SwModel.FirstFeature
- Do While Not SwFeat Is Nothing
- 'Debug.Print SwFeat.Name, SwFeat.GetTypeName
- Set SwSubFeat = SwFeat.GetFirstSubFeature
- Do While Not SwSubFeat Is Nothing
- 'Debug.Print SwSubFeat.GetTypeName
- If SwSubFeat.GetTypeName = "DrTemplate" Or SwSubFeat.GetTypeName = "AbsoluteView" Then
- Debug.Print SwFeat.Name, SwSubFeat.Name, SwSubFeat.GetTypeName
- End If
- Set SwSubFeat = SwSubFeat.GetNextSubFeature
- Loop
- Debug.Print "*******"
- Set SwFeat = SwFeat.GetNextFeature
- Loop
- Stop
- End Sub
复制代码
- Private Sub RngChangeViewName()
- Dim SwApp As SldWorks.SldWorks, SwModel As ModelDoc2
- Set SwApp = Application.SldWorks
- Set SwModel = SwApp.ActiveDoc
- Dim SwDraw As DrawingDoc
- Set SwDraw = SwModel
- Dim SwFeat As Feature, SwSubFeat As Feature
- Set SwFeat = SwModel.FirstFeature
- Do While Not SwFeat Is Nothing
- 'Debug.Print SwFeat.Name, SwFeat.GetTypeName
- Set SwSubFeat = SwFeat.GetFirstSubFeature
- Do While Not SwSubFeat Is Nothing
- 'Debug.Print SwSubFeat.GetTypeName
- Select Case SwSubFeat.GetTypeName
- Case "DrTemplate", "AbsoluteView", "UnfoldedView"
- 'Debug.Print SwFeat.Name, SwSubFeat.Name, SwSubFeat.GetTypeName
- For ii = 1 To Rng.Rows.Count
- If SwSubFeat.Name = Rng(ii, 1) Then
- 'Debug.Print Rng(ii, 2).Address, Rng(ii, 2), SwSubFeat.Name
- If Not IsEmpty(Rng(ii, 2)) Then
- SwSubFeat.Name = Rng(ii, 2)
- 'Stop
- End If
- Exit For
- End If
- Next ii
- End Select
- Set SwSubFeat = SwSubFeat.GetNextSubFeature
- Loop
- 'Debug.Print "*******"
- Set SwFeat = SwFeat.GetNextFeature
- Loop
- 'Stop
- End Sub
复制代码 |
|