Code:
'----------------------------------------------------
' How to hide rows in a BOM(Excel).
'
' Autor: Ing.Sup.Mec. Pedro Omar Sánchez Curbelo
' Sevilla. Spain. 9 april 2005
'
' Preconditions:
'
' (1) Drawing document is open.
' (2) Drawing contains one View with BOM(Excel).
'
' Postconditions: Hide Rows in BOM (from 3 to 4).
'
'----------------------------------------------------
Option ExplicitPublic Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Const WM_MOUSEACTIVATE = &H21
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_SETCURSOR = &H20
Public Const WM_PAINT = &HF
Public Const MK_LBUTTON = &H1
Public Const HTCLIENT = 1
Public Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
' Constantes de GetWindow()
Public Const GW_CHILD = 5
Public Const GW_HWNDFIRST = 0
Public Const GW_HWNDLAST = 1
Public Const GW_HWNDNEXT = 2
Public Const GW_HWNDPREV = 3
Public Const GW_MAX = 5
Public Const GW_OWNER = 4
Public Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Public Declare Function IsWindow Lib "user32" (ByVal hwnd As Long) As Long
Public Const swDocDRAWING = 3 ' Used to be TYPE_DRAWING
Public swApp As Object ' SldWorks.SldWorks '
Public swModel As Object 'SldWorks.ModelDoc2 '
Public swDraw As Object 'SldWorks.DrawingDoc '
Public swView As Object 'SldWorks.View '
Public swViewBOM As Object ' SldWorks.BomTable '
Public SwHwnd As Long
Public hWndMView As Long
Public BeforehWindow As Long
Sub main()
Dim Frme As Object 'SldWorks.Frame '
Dim mModelView As Object 'SldWorks.ModelView '
Dim swView_Name As String
Dim bRet As Boolean
Set swApp = GetObject(, "SldWorks.Application")
If swApp Is Nothing Then
MsgBox "It was not possible to be connected with SolidWorks"
Exit Sub
End If
Set Frme = swApp.Frame
SwHwnd = Frme.GetHWnd 'Handle de SW.
Set Frme = Nothing
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Then
MsgBox "There is no active document"
Set swApp = Nothing
Exit Sub
End If
If swModel.GetType <> swDocDRAWING Then
MsgBox "Only Allowed on document DRAWs"
Set swApp = Nothing
Exit Sub
End If
Set mModelView = swModel.ActiveView
hWndMView = mModelView.GetViewHWnd()
Set mModelView = Nothing
BeforehWindow = GetWindow(hWndMView, GW_CHILD)
Set swDraw = swModel
Set swView = swDraw.GetFirstView
Set swView = swView.GetNextView
Do While Not swView Is Nothing
swView_Name = swView.Name
bRet = swModel.Extension.SelectByID2(swView_Name, "DRAWINGVIEW", 0, 0, 0, False, 0, Nothing, 0)
If bRet <> False Then
Set swViewBOM = swView.GetBomTable
If Not swViewBOM Is Nothing Then
'Hide 2 to 4 rows
If HideRows(3, 4) Then
Call ActivaMView
Exit Do
End If
End If
End If
Set swView = swView.GetNextView
Loop
Set swView = Nothing
Set swDraw = Nothing
Set swModel = Nothing
Set swApp = Nothing
End Sub
Public Function HideRows(FromRow As Long, ToRow As Long) As Boolean
On Error GoTo ErrorControl
Dim xlsApp As Object 'Excel.Application '
Dim xlsWB As Object 'Excel.Workbook '
Dim xlsSht As Object 'Excel.Worksheet '
Dim i As Long
Dim bRet As Boolean
bRet = swViewBOM.Attach3
If Abs(CLng(bRet)) <> 1 Then
MsgBox "Error attacking the BOM"
HideRows = False
Exit Function
End If
Set xlsApp = GetObject(, "Excel.Application")
If xlsApp Is Nothing Then
MsgBox "It was not possible to be connected with Excel"
HideRows = False
Exit Function
End If
Set xlsWB = xlsApp.ActiveWorkbook
If Not xlsWB Is Nothing Then
Set xlsSht = xlsWB.Sheets(1)
If Not xlsSht Is Nothing Then
For i = FromRow To ToRow
xlsSht.Rows(i & ":" & i).Hidden = True
Next i
End If
Set xlsSht = Nothing
End If
Set xlsWB = Nothing
Set xlsApp = Nothing
'swViewBOM.Detach
Set swViewBOM = Nothing
HideRows = True
Exit Function
ErrorControl:
Err.Clear
HideRows = False
MsgBox "Error While work with Excel"
End Function
Public Sub ActivaMView()
Dim PtoPack As Long
Dim hWindow As Long
Dim lngResult As Long
SendMessage hWndMView, WM_MOUSEACTIVATE, ByVal CLng(SwHwnd), ByVal MAKELONG(HTCLIENT, WM_LBUTTONDOWN)
SendMessage hWndMView, WM_SETCURSOR, ByVal CLng(hWndMView), ByVal MAKELONG(HTCLIENT, WM_LBUTTONDOWN)
PtoPack = (1 * &H10000) + 1
PostMessage hWndMView, WM_LBUTTONDOWN, ByVal CLng(MK_LBUTTON), ByVal PtoPack
SendMessage hWndMView, WM_PAINT, 0, ByVal 0
OTRS:
hWindow = GetWindow(hWndMView, GW_CHILD)
If hWindow = BeforehWindow Then Exit Sub
lngResult = WaitForSingleObject(hWindow, 2000)
If IsWindow(hWindow) = 0 Then
Exit Sub
Else
DoEvents
GoTo OTRS
End If
End Sub
Public Function MAKELONG(wLow As Long, wHigh As Long) As Long
MAKELONG = LOWORD(wLow) Or (&H10000 * LOWORD(wHigh))
End Function
Public Function LOWORD(dwValue As Long) As Integer
CopyMemory LOWORD, dwValue, 2
End Function
Foren auf CAD.de (alle Foren)
| 
