Option Explicit
' ***********************************************************************
' 目的： 标准功能模块
' 作者: SUNNYTECH Huting <[email protected]>
' 编程语言: VB
' 语言: 中文
' CATIA Level: V5R9
' ***********************************************************************
' --------------------------------------------------------------
' 窗口属性设定API声明
' --------------------------------------------------------------
Private Declare Function SetWindowPos Lib "user32" ( _
ByVal hwnd As Long, _
ByVal hWndInsertAfter As Long, _
ByVal x As Long, ByVal y As Long, _
ByVal cx As Long, ByVal cy As Long, _
ByVal wFlags As Long) As Long
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
' --------------------------------------------------------------
' 基本变量定义
' --------------------------------------------------------------
Public CATIA As INFITF.Application
Public oProductDoc As ProductDocument
Public oPartDoc As PartDocument
Public oDrawingDoc As DrawingDocument
Public oPart As Part
Public oBodies As Bodies
Public oBody As Body
Public oHBodies As HybridBodies
Public oHBody As HybridBody
Public oSF As ShapeFactory
Public oHSF As HybridShapeFactory
' ***********************************************************************
' 目的： 初始化CATIA产品文档，并初始化必要的基本变量
'
' 输入： bNewProduct: 初始化时是否新建产品文件
' 可选，默认新建文件
' strProduct: 初始化时是否打开已经存在的产品文件
' 可选，默认新建文件
' ***********************************************************************
Sub InitCATIAProduct(Optional bNewProduct As Boolean = True, _
Optional strProduct As String = "")
On Error Resume Next
Set CATIA = GetObject(, "CATIA.Application")
If Err.Number <> 0 Then
Set CATIA = CreateObject("CATIA.Application")
CATIA.Visible = True
End If
If bNewProduct Then
Set oProductDoc = CATIA.Documents.Add("Product")
Else
If strProduct = "" Then
Set oProductDoc = CATIA.ActiveDocument
If oProductDoc Is Nothing Then
Err.Clear
Set oProductDoc = CATIA.Documents.Add("Product")
End If
Else
If Dir(strProduct) <> "" Then
Set oProductDoc = CATIA.Documents.Open(strProduct)
Else
MsgBox "指定的文件不存在！"
End
End If
End If
End If
On Error GoTo 0
End Sub
' ***********************************************************************
' 目的： 初始化CATIA零件文档，并初始化必要的基本变量
'
' 输入： bNewPart: 初始化时是否新建零件文件
' 可选，默认新建文件
' strPart: 初始化时是否打开已经存在的零件文件
' 可选，默认新建文件
' ***********************************************************************
Sub InitCATIAPart(Optional bNewPart As Boolean = True, _
Optional strPart As String = "")
On Error Resume Next
Set CATIA = GetObject(, "CATIA.Application")
If Err.Number <> 0 Then
Set CATIA = CreateObject("CATIA.Application")
CATIA.Visible = True
End If
If bNewPart Then
Set oPartDoc = CATIA.Documents.Add("Part")
Else
If strPart = "" Then
Set oPartDoc = CATIA.ActiveDocument
If oPartDoc Is Nothing Then
Err.Clear
Set oPartDoc = CATIA.Documents.Add("Part")
End If
Else
If Dir(strPart) <> "" Then
Set oPartDoc = CATIA.Documents.Open(strPart)
Else
MsgBox "指定的文件不存在！"
End
End If
End If
End If
Set oPart = oPartDoc.Part
Set oBodies = oPart.Bodies
Set oBody = oPart.MainBody
Set oHBodies = oPart.HybridBodies
Set oSF = oPart.ShapeFactory
Set oHSF = oPart.HybridShapeFactory
On Error GoTo 0
End Sub
' ***********************************************************************
' 目的： 初始化CATIA工程图文档，并初始化必要的基本变量
'
' 输入： bNewDrawing: 初始化时是否新建零件文件
' 可选，默认新建文件
' strDrawing: 初始化时是否打开已经存在的工程图文件
' 可选，默认新建文件
' ***********************************************************************
Sub InitCATIADrawing(Optional bNewDrawing As Boolean = True, _
Optional strDrawing As String = "")
On Error Resume Next
Set CATIA = GetObject(, "CATIA.Application")
If Err.Number <> 0 Then
Set CATIA = CreateObject("CATIA.Application")
CATIA.Visible = True
End If
If bNewDrawing Then
Set oDrawingDoc = CATIA.Documents.Add("Drawing")
Else
If bNewDrawing = "" Then
Set oDrawingDoc = CATIA.ActiveDocument
If oDrawingDoc Is Nothing Then
Err.Clear
Set oDrawingDoc = CATIA.Documents.Add("Drawing")
End If
Else
If Dir(bNewDrawing) <> "" Then
Set oDrawingDoc = CATIA.Documents.Open(strDrawing)
Else
MsgBox "指定的文件不存在！"
End
End If
End If
End If
On Error GoTo 0
End Sub
' ***********************************************************************
' 目的： 设置窗口使其始终在其它窗口上面
'
' 输入： iHwnd: 要设置的窗口句柄
' bOnTop: 设置或取消窗口的置顶属性
' 可选，默认为真
' ***********************************************************************
Sub MakeMeOnTop(iHwnd As Long, Optional bOnTop As Boolean = True)
If bOnTop Then
SetWindowPos iHwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE
Else
SetWindowPos iHwnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE
End If
End Sub
' ***********************************************************************
' 目的： 添加新的几何元素集
'
' 输入： HBodyName: 几何元素集名称
' ***********************************************************************
Function AddHBody(Optional HBodyName As String = "") As HybridBody
Dim oHB As HybridBody
On Error Resume Next
Set oHB = oHBodies.Add()
If HBodyName <> "" Then
oHB.Name = HBodyName
End If
Set AddHBody = oHB
On Error GoTo 0
End Function
' ***********************************************************************
' 目的： 隐藏/显示元素
'
' 输入： Element: 要隐藏/显示的元素
' isShow: 要隐藏或显示该元素
' 可选，默认隐藏
' ***********************************************************************
Sub HideShow(Element, Optional isShow As Boolean = False)
Dim RefElement As Reference
Set RefElement = oPart.CreateReferenceFromObject(Element)
oHSF.GSMVisibility RefElement, isShow
End Sub
评论0