遍历打开的SldPrt、SldAsm和SldDrw文件。

pbfj

   经典图书

• Private Sub ll()
  
• Dim SwApp As SldWorks.SldWorks
  
• Set SwApp = Application.SldWorks
  
• Dim SwModel As ModelDoc2
  
• Set SwModel = SwApp.GetFirstDocument
  
• 
  
• Debug.Print SwModel.GetTitle
  
• Do While Not SwModel Is Nothing
  
• Debug.Print SwModel.GetTitle
  
• Set SwModel = SwModel.GetNext
  
• Loop
  
• 
  
• Stop
  
• End Sub
  

复制代码
运行结果
BasePlateS.SLDPRT
BasePlateS.SLDPRT
BasePlateS.SLDPRT
Web.sldprt
Pad.sldprt
Rib1.SLDPRT
Rib2.SLDPRT
Rib3.SLDPRT
Saddle.SLDASM
Draw1 - Sheet1
V=100 Dn3800×18 L=7500) - BI3800装配图
‘’切换两个SldDrw文件的切换

• ''
  
• Private Sub l4()
  
• Dim SwApp As SldWorks.SldWorks
  
• Dim SwModel As ModelDoc2, SwModelArr() As ModelDoc2
  
• Set SwApp = Application.SldWorks
  
• Set SwModel = SwApp.GetFirstDocument
  
• Dim Kk As Integer
  
• Do While Not SwModel Is Nothing
  
• If SwModel.GetType = 3 Then
  
• ReDim Preserve SwModelArr(Kk) As ModelDoc2
  
• Set SwModelArr(Kk) = SwModel
  
• Kk = Kk + 1
  
• End If
  
• Set SwModel = SwModel.GetNext
  
• Loop
  
• ''
  
• Set SwModel = SwModelArr(1)
  
• Debug.Print SwModel.GetTitle
  
• ''
  
• SwModel.ClearSelection2 True
  
• ''
  
• Dim SwFeat As Feature
  
• Set SwFeat = SwModel.FirstFeature
  
• Do While Not SwFeat Is Nothing
  
• If SwFeat.GetTypeName = "DrSheet" Then
  
• Debug.Print SwFeat.Name, SwFeat.GetTypeName
  
• SwFeat.Select True
  
• End If
  
• Set SwFeat = SwFeat.GetNextFeature
  
• Loop
  
• Debug.Print SwModel.GetTitle
  
• SwModel.EditCopy
  
• Set SwModel = SwModelArr(0)
  
• Debug.Print SwModel.GetTitle
  
• SwApp.ActivateDoc (SwModel.GetTitle)
  
• 
  
• SwModel.Paste
  
• End Sub
  

复制代码

KEYS

没有采用递归方式，在三维装配体或二维装配体图纸状态中可能遍历不彻底。

hy7758521

   经典图书

深层遍历有什么有，遍历太深，一大堆数据看不过来，等于垃圾。

hiworker

浅!!!

UDF998

   经典案例图书

很不错，找到组织了！