获得图纸n个sheet名称

崔芝兰

  

'Get Sheet Numbers and Names Example (VB)
'This example shows how to get the sheet numbers and names for multiple sheets in a drawing document.
'---------------------------------------------
'
' Preconditions: Drawing document is open and has multiple sheets.
'
' Postconditions: None
'
'---------------------------------------------
Option Explicit
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Dim swSheet As SldWorks.Sheet
Dim vSheetNames As Variant
Dim bRet As Boolean
Dim i As Long
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swDraw = swModel
Set swSheet = swDraw.GetCurrentSheet
Debug.Print "FileName = " + swModel.GetPathName
Debug.Print " Current sheet = " & swSheet.GetName
Debug.Print ""
vSheetNames = swDraw.GetSheetNames
For i = 0 To UBound(vSheetNames)
Debug.Print " SheetName[" & i & "] = " & vSheetNames(i)
Next i
End Sub
'---------------------------------------------

复制代码
在一个slddrw文件中，有n张图纸
此程序的运行结果
FileName = F:BE(J)SBES1800-2.5-1365-9／25-2I件号1管箱.SLDDRW
Current sheet = 件号1管箱
SheetName[0] = 件号1管箱
SheetName[1] = 件号1-1封头
SheetName[2] = 件号1-2筒节
SheetName[3] = 件号1-3法兰
SheetName[4] = 件号1-4接管
SheetName[5] = 件号1-5法兰
SheetName[6] = 件号1-6隔板

'Get Sheet Numbers and Names Example (VB)
'This example shows how to get the sheet numbers and names for multiple sheets in a drawing document.
'---------------------------------------------
'
' Preconditions: Drawing document is open and has multiple sheets.
'
' Postconditions: None
'
'---------------------------------------------
Option Explicit
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Dim swSheet As SldWorks.Sheet
Dim vSheetNames As Variant
Dim bRet As Boolean
Dim i As Long
Dim oName
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swDraw = swModel
With swDraw
Set swSheet = .GetCurrentSheet
Debug.Print .GetSheetCount
'oName = swSheet.GetSheetFormatName
End With
Debug.Print "FileName = " + swModel.GetPathName
Debug.Print " Current sheet = " & swSheet.GetName
Debug.Print ""
vSheetNames = swDraw.GetSheetNames
For i = 0 To UBound(vSheetNames)
Debug.Print " SheetName[" & i & "] = " & vSheetNames(i)
Set swSheet = swDraw.GetCurrentSheet
Debug.Print swSheet.GetSheetFormatName
swDraw.SheetNext
Next i
End Sub
'---------------------------------------------

复制代码
qq.zip (15.48 KB, 下载次数: 22)

2012-1-31 15:07 上传

点击文件名下载附件
下载积分: 金币 -1

superluhua

  

'Get Sheet Numbers and Names Example (VB)
'This example shows how to get the sheet numbers and names for multiple sheets in a drawing document.
'---------------------------------------------
'
' Preconditions: Drawing document is open and has multiple sheets.
'
' Postconditions: None
'
'---------------------------------------------
Option Explicit
Sub main()
    Dim swApp                   As SldWorks.SldWorks
    Dim swModel                 As SldWorks.ModelDoc2
    Dim swDraw                  As SldWorks.DrawingDoc
    Dim swSheet                 As SldWorks.Sheet
    Dim vSheetNames             As Variant
    Dim bRet                    As Boolean
    Dim i                       As Long
    Dim oName
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swDraw = swModel
    With swDraw
      Set swSheet = .GetCurrentSheet
      Debug.Print .GetSheetCount
      
      'oName = swSheet.GetSheetFormatName
    End With
    Debug.Print "FileName = " + swModel.GetPathName
    Debug.Print "  Current sheet = " & swSheet.GetName
    Debug.Print ""
    vSheetNames = swDraw.GetSheetNames
    For i = 0 To UBound(vSheetNames)
        
        Debug.Print "  SheetName[" & i & "] = " & vSheetNames(i)
       swDraw.SheetNext
       Set swSheet = swDraw.GetCurrentSheet
        Debug.Print swSheet.GetSheetFormatName
    Next i
End Sub
'---------------------------------------------

复制代码
Debug.print 运行结果
7
FileName = F:BE(J)SBES1800-2.5-1365-9／25-2I件号1管箱.SLDDRW
  Current sheet = 件号1管箱
  SheetName[0] = 件号1管箱
图纸格式3
  SheetName[1] = 件号1-1封头
图纸格式2
  SheetName[2] = 件号1-2筒节
图纸格式4
  SheetName[3] = 件号1-3法兰
图纸格式5
  SheetName[4] = 件号1-4接管
图纸格式6
  SheetName[5] = 件号1-5法兰
图纸格式7
  SheetName[6] = 件号1-6隔板
图纸格式7
*********************************

Sub fdsfds()
  Dim SwApp
  Set SwApp = CreateObject("SldWorks.Application")
  Set SwDraw = SetSwPart
  PathFile = "E:MyWorkSummaryBE(J)SHG20592-2012SwBaseModel" & "Bl.SldPrt"
  ShtName = "ffff"
  xyArr = Array(Array(0.1, 0.2), Array(0.1, 0.3))
  temp = CreateDrawViewFromModelView(SwApp, SwDraw, PathFile, ShtName, xyArr)
End Sub
''在工程图中，插入sldAsm和sldprt
Function CreateDrawViewFromModelView(SwApp, SwDraw, PathFile, ShtName, xyArr)
  '用CreateDrawViewFromModelView指令，生成视图1和视图2。
  Dim myModelView As Object, SwPart As Object
  Set myModelView = SwDraw.ActiveView
  
  ''
  ''
  With myModelView
     .FrameState = 1
  End With
  
  Dim myView As Object
  With SwDraw
    reVal = .ActivateSheet(ShtName)   ''
    Set SwPart = SwOpenFile(SwApp, PathFile)
    Set myView = .CreateDrawViewFromModelView3(PathFile, "*前视", xyArr(0)(0), xyArr(0)(1), 0)
    'Annotations = .InsertModelAnnotations3(0, 32776, False, True, False, False)
    boolStatus = .ActivateView(myView.Name)
    Set myView = .CreateUnfoldedViewAt3(xyArr(1)(0), xyArr(1)(1), 0, False)
   
    SwApp.CloseDoc ShtName
    Set SwView = .GetFirstView    ''
  End With
  ''
  kk = 1
  While Not SwView Is Nothing
    If SwView.Name Like "*视图*" Then
       SwView.SetName2 (ShtName & kk)
       kk = kk + 1
    End If
    Set SwView = SwView.GetNextView
  Wend
  
End Function

复制代码

Sub ll()
  Dim Arr
  Arr = Array("a1", "a2")
  temp = WithArrayCreateSheetDot(Arr)
End Sub
''
Function WithArrayCreateSheetDot(Arr)
  ''生成Sheet
  Dim DotName, tepDotName, ShtNameArr
  DotName = ThisWorkbook.Path + "MatDrtTbtmyA3.slddrt"
  Dim SwApp, SwDraw As Object, SwArr
  Dim xyArr(1)
  xyArr(0) = Array(0.1, 0.2)
  xyArr(1) = Array(0.3, 0.2)   
  Set SwDraw = SetSwPart
  ''
  temp = CreateSwSheet(SwDraw, Arr, DotName)
End Function

复制代码

qianjk

感謝分享

longlong

多谢分享。能说明一个有用的使用场合吗？案例？

jyzas001

   经典案例图书

附件损坏打不开

jyzas001

谢谢分享

fendou007

   经典案例图书

很不错，顶一下！

liyuyin007

活到老学到老！