链接CATIA.rar_catia_二次开发

Option Explicit ' *********************************************************************** ' 目的： 标准功能模块 ' 作者: SUNNYTECH Huting <tianshuen@gmail.com> ' 编程语言: 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