Bootstrap

CATIA二次开发VBA入门(5)——catia文档操作vb.net程序案例,打开catia文件,进行视图操作,退出程序

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

引出

CATIA二次开发VBA入门(5)——catia文档操作vb.net程序案例,打开catia文件,进行视图操作,退出程序


catia文档操作案例

1.初始化窗体,始终置顶

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

    ' --------------------------------------------------------------
    ' 窗口属性设定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

    ' ***********************************************************************
    '   目的:      设置窗口使其始终在其它窗口上面
    '
    '   输入:      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

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

始终置顶方式2

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

2.打开文件

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

在较旧版本的Visual Basic中,如VB6及其之前的版本,CommonDialog 控件用于提供一个通用的对话框界面,可以用于打开文件、保存文件、选择颜色或打印文档等功能。用户可以通过在工具箱中添加 CommonDialog 控件到窗体上,然后在代码中设置其属性和调用其方法来使用这些标准对话框。

以下是使用 CommonDialog 控件的一个简单例子:

vb
' 设置对话框的操作为打开文件
CommonDialog1.Action = vbCommonDialogOpenFile

' 显示打开文件对话框
CommonDialog1.ShowOpen

' 使用用户选择的文件名
If CommonDialog1.FileName <> "" Then
    MsgBox "您选择的文件是:" & CommonDialog1.FileName
End If

然而,在.NET环境中(比如VB.NET),CommonDialog 控件已经被不同的专用对话框控件所替代,例如:

  • OpenFileDialog - 打开文件对话框
  • SaveFileDialog - 保存文件对话框
  • ColorDialog - 颜色选择对话框
  • FontDialog - 字体选择对话框
  • PrintDialog - 打印对话框

在VB.NET中使用这些对话框通常更简单、更直接,不需要设置 Action 属性,只需要创建对话框的实例,设置所需的属性,并调用 ShowDialog 方法即可。例如,使用 OpenFileDialog 的代码如下:

' 创建打开文件对话框的实例
Dim openFileDialog As New OpenFileDialog()

' 配置对话框的属性
openFileDialog.Title = "选择文件"
openFileDialog.Filter = "所有文件 (*.*)|*.*"

' 显示对话框并检查对话框结果
If openFileDialog.ShowDialog() = DialogResult.OK Then
    ' 获取用户选择的文件名
    MessageBox.Show("您选择的文件是:" & openFileDialog.FileName)
End If

使用这种方式,你可以为你的VB.NET应用程序提供一个现代化和一致的对话框体验。

3.视图切换

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

4.退出

在Visual Basic 6.0及其之前的版本中,Unload Me 是一条常用的语句,用于从内存中卸载当前窗体。然而,在Visual Basic .NET(VB.NET)中,这个语句不再适用,因为VB.NET采用了不同的窗体管理和内存管理机制。

在VB.NET中,要关闭当前窗体,你应该使用 Me.Close() 方法。这个方法会关闭窗体并释放其占用的资源。例如:

' 关闭当前窗体
Me.Close()

Me.Close() 方法会触发窗体的 FormClosedFormClosing 事件,你可以在这些事件中执行任何必要的清理工作。

如果你想要从内存中完全移除窗体,以便它不再可用,并且可以被垃圾回收器回收,你可以在窗体的 FormClosed 事件中设置窗体变量为 Nothing

Private Sub YourForm_FormClosed(sender As Object, e As FormClosedEventArgs) Handles Me.FormClosed
    ' 设置窗体变量为 Nothing,以便它可以被垃圾回收
    YourForm = Nothing
End Sub

请注意,在VB.NET中,窗体通常是按需加载的,这意味着只有当窗体被显示时,它才会被加载到内存中。当窗体被关闭时,它通常会被卸载,除非有其他代码或事件保持对它的引用。因此,在大多数情况下,你不需要手动卸载窗体,Me.Close() 就足够了。

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

5.完整代码

model

Imports MECMOD
Imports PARTITF
Imports HybridShapeTypeLib

Module Module1
    Public CATIA As INFITF.Application
    Public oPartDoc As PartDocument
    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 InitCATIAPart(Optional ByVal bNewPart As Boolean = True,
                      Optional ByVal strPart As String = "")
        On Error Resume Next '有错误的话会忽略,继续执行下一句 
        ' 如果打开catia,就获取当前的这个

        CATIA = GetObject(, "CATIA.Application")
        If Err.Number <> 0 Then
            ' 如果没有打开catia,则打开新的catia
            CATIA = CreateObject("CATIA.Application")
            CATIA.Visible = True
        End If

        If bNewPart Then
            oPartDoc = CATIA.Documents.Add("Part")
        Else
            If strPart = "" Then
                oPartDoc = CATIA.ActiveDocument
                If oPartDoc Is Nothing Then
                    Err.Clear()
                    oPartDoc = CATIA.Documents.Add("Part")
                End If
            Else
                If Dir(strPart) <> "" Then
                    oPartDoc = CATIA.Documents.Open(strPart)
                Else
                    MsgBox("指定的文件不存在!")
                    End
                End If
            End If
        End If


        On Error GoTo 0

        oPartDoc = CATIA.ActiveDocument
        oPart = oPartDoc.Part
        oBodies = oPart.Bodies
        oBody = oBodies.Item(1)
        oHBodies = oPart.HybridBodies
        oHBody = oHBodies.Add()
        oSF = oPart.ShapeFactory
        oHSF = oPart.HybridShapeFactory

    End Sub

    ' --------------------------------------------------------------
    ' 窗口属性设定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

    ' ***********************************************************************
    '   目的:      设置窗口使其始终在其它窗口上面
    '
    '   输入:      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

End Module

form1

Imports MECMOD
Imports HybridShapeTypeLib
Imports INFITF

Public Class Form1

    ' 窗体初始化的函数
    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load
        On Error Resume Next '有错误的话会忽略,继续执行下一句 
        ' 如果打开catia,就获取当前的这个

        CATIA = GetObject(, "CATIA.Application")
        If Err.Number <> 0 Then
            ' 如果没有打开catia,则打开新的catia
            CATIA = CreateObject("CATIA.Application")
            CATIA.Visible = True
        End If
        On Error GoTo 0

        ' 让catia始终在最上层
        MakeMeOnTop(Me.Handle, True)
    End Sub

    Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
        On Error Resume Next

        Dim openD As New OpenFileDialog()
        openD.Filter = "零件文件|*.CATpart"
        Dim opartdoc As PartDocument = CATIA.ActiveDocument

        If openD.ShowDialog = DialogResult.OK And openD.FileName <> "" Then
            Console.WriteLine(openD.FileName)
            MsgBox(openD.FileName)
            opartdoc = CATIA.Documents.Open(openD.FileName)
        End If

        On Error GoTo 0
    End Sub

    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click

        ' 当前活动视图
        Dim myViewer As Viewer3D
        myViewer = CATIA.ActiveWindow.ActiveViewer
        myViewer.RenderingMode = CatRenderingMode.catRenderShading

        Dim myCams = CATIA.ActiveDocument.Cameras
        Dim myCam As Camera3D
        Console.WriteLine(myCams.Count)
        For i = 1 To myCams.Count - 1
            myCam = myCams(i)
            MsgBox(myCam.Name)

            ' 改变当前的活动视图
            myViewer.Viewpoint3D = myCam.Viewpoint3D

            myViewer.Reframe()
            myViewer.ZoomIn()
            myViewer.Update()
        Next
    End Sub

    Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
        Me.Close()
    End Sub
End Class


总结

CATIA二次开发VBA入门(5)——catia文档操作vb.net程序案例,打开catia文件,进行视图操作,退出程序


其他内容

认识CATIA二次开发

V5 AUTOMATION开发

刘瑞欣 vb程序设计教程

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

Excel中的vba开发

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

catia中的vba开发

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

宏的录制、回放和编辑

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

宏代码精简

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

录制到项目中,录制成一个模块

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

catia的vba开发环境设置,取消dim的限值,这样就可以不用定义变量,便于简化录制的宏程序

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

Sub CATMain()


Set partDocument2 = CATIA.Documents.Add("Part")

Set part2 = partDocument2.Part

Set body1 = part2.Bodies.Item("零件几何体")

Set sketches1 = body1.Sketches

Set originElements1 = part2.OriginElements

Set reference1 = originElements1.PlaneYZ

Set sketch1 = sketches1.Add(reference1)

part2.InWorkObject = sketch1


Set factory2D1 = sketch1.OpenEdition()


Set circle2D1 = factory2D1.CreateClosedCircle(0#, 0#, 20)


sketch1.CloseEdition

part2.InWorkObject = sketch1


Set hybridShapeFactory1 = part2.HybridShapeFactory


Set hybridShapeDirection1 = hybridShapeFactory1.AddNewDirectionByCoord(0#, 0#, 0#)


Set reference2 = part2.CreateReferenceFromObject(sketch1)


Set hybridShapeExtrude1 = hybridShapeFactory1.AddNewExtrude(reference2, 60#, 60#, hybridShapeDirection1)

hybridShapeExtrude1.SymmetricalExtension = 0

body1.InsertHybridShape hybridShapeExtrude1

part2.InWorkObject = hybridShapeExtrude1

part2.Update

End Sub

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

画圆柱阵列

Sub CATMain()


Set partDocument2 = CATIA.Documents.Add("Part")

Set part2 = partDocument2.Part

Set body1 = part2.Bodies.Item("零件几何体")

Set sketches1 = body1.Sketches

Set originElements1 = part2.OriginElements

Set reference1 = originElements1.PlaneYZ

Set sketch1 = sketches1.Add(reference1)

part2.InWorkObject = sketch1


Set factory2D1 = sketch1.OpenEdition()
'--------------------------------------------

For i = 0 To 99

Set circle2D1 = factory2D1.CreateClosedCircle(50 * i, 0#, 20)

Next

'--------------------------------------------
sketch1.CloseEdition

part2.InWorkObject = sketch1


Set hybridShapeFactory1 = part2.HybridShapeFactory


Set hybridShapeDirection1 = hybridShapeFactory1.AddNewDirectionByCoord(0#, 0#, 0#)


Set reference2 = part2.CreateReferenceFromObject(sketch1)


Set hybridShapeExtrude1 = hybridShapeFactory1.AddNewExtrude(reference2, 60#, 60#, hybridShapeDirection1)

hybridShapeExtrude1.SymmetricalExtension = 0

body1.InsertHybridShape hybridShapeExtrude1

part2.InWorkObject = hybridShapeExtrude1

part2.Update

End Sub


每次画完都自动更新,这样能实时看到caita的变化

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

宏Macro文件的3种类型

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

宏的保存:文件夹,项目,catia文件

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

保存到文件中的两种后缀格式,catiaScript和vbScript,即catia脚本和vb脚本

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

catvba模式的导出

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

宏的默认编辑器设置

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

宏加入到工具条中

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

选择catiavba项目作为当前的宏库

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

工具,自定义选项卡

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

可以设置图标

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

按住,拖到工具条中

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

方式一:工具条中,点击图标运行,显示弹窗

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

方式二:作为catia脚本,直接双击运行

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

插曲:工具条的恢复

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

进程外开发环境搭建和案例

vb.net和vb6.0

在这里插入图片描述

VB.NET一种简单,现代,面向对象计算机编程语言,有微软开发,VB.NET是一种基于.NET Framework的面向对象编程语言,它是Visual Basic语言的继承者,但是与早期版本的Visual Basic有很大的不同。VB.NET是一种强类型语言,支持类、接口委托、异常处理、LINQ等现代编程特性,可以开发Windows应用程序、Web应用程序、服务和组价。它还支持多线程和异步编程,并且可以与其他的.NET语言(如C#)进行交互。VB.NET是一种易学易用的语言,适合初学者和专业开发人员

特点:

1.面向对象:VB.NET 是一种完全面向对象的语言,支持封装、继承和多态等面向对象的特性。

2.强类型:VB.NET 是一种强类型语言,需要在编译时进行类型检查,避免在运行时出现类型错误。

3.安全性:VB.NET 具有良好的安全性,支持代码访问权限控制、类型安全、内存管理等功能,可以有效地防止程序运行时出现安全问题。

4.可扩展性:VB.NET 可以轻松地扩展和定制,可以使用 COM 组件、.NET 组件和自定义组件等方式扩展应用程序的功能。

5.多平台支持:VB.NET 可以运行在多个操作系统上,包括 Windows、Linux 和 macOS 等。

6.集成开发环境:VB.NET 可以与 Visual Studio 集成使用,提供了丰富的开发工具和调试功能,可以提高开发效率和代码质量。

7.数据库支持:VB.NET 提供了对多种数据库的支持,包括 ADO.NET、OLE DB 和 ODBC 等,可以方便地访问和操作数据库

VB.NET和VB6.两种不同的Visual Basic版本,它们在语言、架构、开发环境、应用场景等方面都有很大的差异。

不同之处
类型语言架构开发环境应用场景编译器文件格式
VB.NET完全面向对象语言支持更多语言:泛型,LINNQ,匿名来类型.NET Framework支持更多.NET Framework特性:Windows Forms,WPF,ASP.NETVisual Studio构建大型的企业级应用用程序.NETVB或VB.ET
VB6.0基于事件语言COM集成开发环境(IDE)小型的应用程序和系统内的维护和升级Microsoft Vissual Basic 6.0.frm、.cls.bas等

进程外开发环境搭建

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

vb.net开发环境搭建

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

  • 新建模块

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

创建了窗口和模块

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

《CATIA二次开发技术基础》模板

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

Imports INFITF

Module Module1

    Public CATIA As INFITF.Application

    Public Sub Main()
        On Error Resume Next '有错误的话会忽略,继续执行下一句 
        ' 如果打开catia,就获取当前的这个
        CATIA = GetObject(, "CATIA.Application")
        If Err.Number <> 0 Then
            ' 如果没有打开catia,则打开新的catia
            CATIA = CreateObject("CATIA.Application")
            CATIA.Visible = True
        End If
        On Error GoTo 0
    End Sub

End Module

在这里插入图片描述

添加宏库引用

catia自带的vba开发环境已经引用了很多库

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

需要在vb中引入import

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

vs开发环境初步

vs中的立即窗口

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

Imports MECMOD

Module Module1
    Public CATIA As INFITF.Application
    Public oPartDoc As PartDocument
    Sub Main()

        On Error Resume Next '有错误的话会忽略,继续执行下一句 
        ' 如果打开catia,就获取当前的这个

        CATIA = GetObject(, "CATIA.Application")
        If Err.Number <> 0 Then
            ' 如果没有打开catia,则打开新的catia
            CATIA = CreateObject("CATIA.Application")
            CATIA.Visible = True
        End If
        On Error GoTo 0

        oPartDoc = CATIA.ActiveDocument
        MsgBox(oPartDoc.Name)

    End Sub

End Module

对象浏览器

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

Imports MECMOD

Module Module1
    Public CATIA As INFITF.Application
    Public oPartDoc As PartDocument
    Public oPart As Part
    Public oBodies As Bodies
    Public oBody As Body
    Sub Main()
        On Error Resume Next '有错误的话会忽略,继续执行下一句 
        ' 如果打开catia,就获取当前的这个

        CATIA = GetObject(, "CATIA.Application")
        If Err.Number <> 0 Then
            ' 如果没有打开catia,则打开新的catia
            CATIA = CreateObject("CATIA.Application")
            CATIA.Visible = True
        End If
        On Error GoTo 0

        oPartDoc = CATIA.ActiveDocument
        'MsgBox(oPartDoc.Name)

        oPart = oPartDoc.Part
        oBodies = oPart.Bodies
        oBody = oBodies.Item(1)
        MsgBox(oBody.Name)
    End Sub

End Module

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

建立模板

可以把设置好库函数的引用的工程文件,作为一个标准的模板,后面直接复制这个标准模板,然后在这上面开发,就不需要每次都要创建各种引用了。

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

案例:创建一堆圆柱曲面

先创建一个宏库,用于保存接下来要录制的宏程序

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

第一步:录制宏

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

然后,工具,宏,启动录制,新建一个part,草图编辑,然后拉升,获得一个圆柱

编辑录制的宏

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

Sub CATMain()

Dim documents1 As Documents
Set documents1 = CATIA.Documents

Dim partDocument1 As PartDocument
Set partDocument1 = documents1.Add("Part")

Dim part1 As Part
Set part1 = partDocument1.Part

Dim bodies1 As Bodies
Set bodies1 = part1.Bodies

Dim body1 As Body
Set body1 = bodies1.Item("零件几何体")

Dim sketches1 As Sketches
Set sketches1 = body1.Sketches

Dim originElements1 As OriginElements
Set originElements1 = part1.OriginElements

Dim reference1 As Reference
Set reference1 = originElements1.PlaneXY

Dim sketch1 As Sketch
Set sketch1 = sketches1.Add(reference1)

Dim arrayOfVariantOfDouble1(8)
arrayOfVariantOfDouble1(0) = 0#
arrayOfVariantOfDouble1(1) = 0#
arrayOfVariantOfDouble1(2) = 0#
arrayOfVariantOfDouble1(3) = 1#
arrayOfVariantOfDouble1(4) = 0#
arrayOfVariantOfDouble1(5) = 0#
arrayOfVariantOfDouble1(6) = 0#
arrayOfVariantOfDouble1(7) = 1#
arrayOfVariantOfDouble1(8) = 0#
Set sketch1Variant = sketch1
sketch1Variant.SetAbsoluteAxisData arrayOfVariantOfDouble1

part1.InWorkObject = sketch1

Dim factory2D1 As Factory2D
Set factory2D1 = sketch1.OpenEdition()

Dim geometricElements1 As GeometricElements
Set geometricElements1 = sketch1.GeometricElements

Dim axis2D1 As Axis2D
Set axis2D1 = geometricElements1.Item("绝对轴")

Dim line2D1 As Line2D
Set line2D1 = axis2D1.GetItem("横向")

line2D1.ReportName = 1

Dim line2D2 As Line2D
Set line2D2 = axis2D1.GetItem("纵向")

line2D2.ReportName = 2

Dim circle2D1 As Circle2D
Set circle2D1 = factory2D1.CreateClosedCircle(0#, 0#, 25#)

circle2D1.ReportName = 3

Dim constraints1 As Constraints
Set constraints1 = sketch1.Constraints

Dim reference2 As Reference
Set reference2 = part1.CreateReferenceFromObject(circle2D1)

Dim constraint1 As Constraint
Set constraint1 = constraints1.AddMonoEltCst(catCstTypeRadius, reference2)

constraint1.Mode = catCstModeDrivingDimension

Dim length1 As Length
Set length1 = constraint1.Dimension

length1.Value = 25#

sketch1.CloseEdition

part1.InWorkObject = sketch1

part1.UpdateObject sketch1

Dim hybridShapeFactory1 As HybridShapeFactory
Set hybridShapeFactory1 = part1.HybridShapeFactory

Dim hybridShapeDirection1 As HybridShapeDirection
Set hybridShapeDirection1 = hybridShapeFactory1.AddNewDirectionByCoord(0#, 0#, 0#)

Dim reference3 As Reference
Set reference3 = part1.CreateReferenceFromObject(sketch1)

Dim hybridShapeExtrude1 As HybridShapeExtrude
Set hybridShapeExtrude1 = hybridShapeFactory1.AddNewExtrude(reference3, 20#, 0#, hybridShapeDirection1)

hybridShapeExtrude1.SymmetricalExtension = 0

body1.InsertHybridShape hybridShapeExtrude1

part1.InWorkObject = hybridShapeExtrude1

part1.Update

End Sub


第二步:代码精简

代码精简

Sub CATMain()


Set documents1 = CATIA.Documents
Set partDocument1 = documents1.Add("Part")
Set part1 = partDocument1.Part
Set bodies1 = part1.Bodies
Set body1 = bodies1.Item("零件几何体")
Set sketches1 = body1.Sketches
Set originElements1 = part1.OriginElements
Set reference1 = originElements1.PlaneXY
Set sketch1 = sketches1.Add(reference1)


Set factory2D1 = sketch1.OpenEdition()
Set circle2D1 = factory2D1.CreateClosedCircle(0#, 0#, 5#)
Set constraints1 = sketch1.Constraints
Set reference2 = part1.CreateReferenceFromObject(circle2D1)
Set constraint1 = constraints1.AddMonoEltCst(catCstTypeRadius, reference2)


Set length1 = constraint1.Dimension
length1.Value = 5#
sketch1.CloseEdition
part1.InWorkObject = sketch1
part1.Update


Set hybridShapeFactory1 = part1.HybridShapeFactory
Set hybridShapeDirection1 = hybridShapeFactory1.AddNewDirectionByCoord(0#, 0#, 0#)
Set reference3 = part1.CreateReferenceFromObject(sketch1)
Set hybridShapeExtrude1 = hybridShapeFactory1.AddNewExtrude(reference3, 20#, 0#, hybridShapeDirection1)
'hybridShapeExtrude1.SymmetricalExtension = 0

body1.InsertHybridShape hybridShapeExtrude1
part1.InWorkObject = hybridShapeExtrude1  '需要加上,不然不会自动更新
part1.Update

End Sub

第三步:for循环改造

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

for循环改造

Sub CATMain()


Set documents1 = CATIA.Documents
Set partDocument1 = documents1.Add("Part")
Set part1 = partDocument1.Part
Set bodies1 = part1.Bodies
Set body1 = bodies1.Item("零件几何体")

X = 0
For i = 1 To 5

Set sketches1 = body1.Sketches
Set originElements1 = part1.OriginElements
Set reference1 = originElements1.PlaneXY
Set sketch1 = sketches1.Add(reference1)
Set factory2D1 = sketch1.OpenEdition()

Set circle2D1 = factory2D1.CreateClosedCircle(X, 0#, 5#)

Set constraints1 = sketch1.Constraints
Set reference2 = part1.CreateReferenceFromObject(circle2D1)
Set constraint1 = constraints1.AddMonoEltCst(catCstTypeRadius, reference2)


Set length1 = constraint1.Dimension
length1.Value = 5#
sketch1.CloseEdition
part1.InWorkObject = sketch1
part1.Update


Set hybridShapeFactory1 = part1.HybridShapeFactory
Set hybridShapeDirection1 = hybridShapeFactory1.AddNewDirectionByCoord(0#, 0#, 0#)
Set reference3 = part1.CreateReferenceFromObject(sketch1)
Set hybridShapeExtrude1 = hybridShapeFactory1.AddNewExtrude(reference3, 20#, 0#, hybridShapeDirection1)
'hybridShapeExtrude1.SymmetricalExtension = 0

body1.InsertHybridShape hybridShapeExtrude1
part1.InWorkObject = hybridShapeExtrude1  '需要加上,不然不会自动更新
part1.Update

X = X + 20
Next
part1.Update


End Sub

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

第四步:人机交互改造

顶部对齐

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

在这里插入图片描述

Private Sub CommandButton1_Click()

Set documents1 = CATIA.Documents
Set partDocument1 = documents1.Add("Part")
Set part1 = partDocument1.Part
Set bodies1 = part1.Bodies
Set body1 = bodies1.Item("零件几何体")

X = 0
For i = 1 To TextBox1.Value

Set sketches1 = body1.Sketches
Set originElements1 = part1.OriginElements
Set reference1 = originElements1.PlaneXY
Set sketch1 = sketches1.Add(reference1)
Set factory2D1 = sketch1.OpenEdition()

Set circle2D1 = factory2D1.CreateClosedCircle(X, 0#, 5#)

Set constraints1 = sketch1.Constraints
Set reference2 = part1.CreateReferenceFromObject(circle2D1)
Set constraint1 = constraints1.AddMonoEltCst(catCstTypeRadius, reference2)


Set length1 = constraint1.Dimension
length1.Value = 5#
sketch1.CloseEdition
part1.InWorkObject = sketch1
part1.Update


Set hybridShapeFactory1 = part1.HybridShapeFactory
Set hybridShapeDirection1 = hybridShapeFactory1.AddNewDirectionByCoord(0#, 0#, 0#)
Set reference3 = part1.CreateReferenceFromObject(sketch1)
Set hybridShapeExtrude1 = hybridShapeFactory1.AddNewExtrude(reference3, 20#, 0#, hybridShapeDirection1)
'hybridShapeExtrude1.SymmetricalExtension = 0

body1.InsertHybridShape hybridShapeExtrude1
part1.InWorkObject = hybridShapeExtrude1  '需要加上,不然不会自动更新
part1.Update

X = X + TextBox2.Value
Next
part1.Update


End Sub

窗口模态设置

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

导出窗口fm

这里本来想导出vba中创建的窗口,然后在vb.net中导入,直接使用,但是两个版本的vb差别较大,并没有成功

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

添加现有项失败,可能是版本的问题,毕竟vb是很老的,我这里用的是vs

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

第五步:搭建vs的开发环境

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

Imports MECMOD
Imports PARTITF
Imports HybridShapeTypeLib

Module Module1
    Public CATIA As INFITF.Application
    Public oPartDoc As PartDocument
    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 InitCATIAPart(Optional ByVal bNewPart As Boolean = True,
                      Optional ByVal strPart As String = "")
        On Error Resume Next '有错误的话会忽略,继续执行下一句 
        ' 如果打开catia,就获取当前的这个

        CATIA = GetObject(, "CATIA.Application")
        If Err.Number <> 0 Then
            ' 如果没有打开catia,则打开新的catia
            CATIA = CreateObject("CATIA.Application")
            CATIA.Visible = True
        End If

        If bNewPart Then
            oPartDoc = CATIA.Documents.Add("Part")
        Else
            If strPart = "" Then
                oPartDoc = CATIA.ActiveDocument
                If oPartDoc Is Nothing Then
                    Err.Clear()
                    oPartDoc = CATIA.Documents.Add("Part")
                End If
            Else
                If Dir(strPart) <> "" Then
                    oPartDoc = CATIA.Documents.Open(strPart)
                Else
                    MsgBox("指定的文件不存在!")
                    End
                End If
            End If
        End If


        On Error GoTo 0

        oPartDoc = CATIA.ActiveDocument
        oPart = oPartDoc.Part
        oBodies = oPart.Bodies
        oBody = oBodies.Item(1)
        oHBodies = oPart.HybridBodies
        oHBody = oHBodies.Add()
        oSF = oPart.ShapeFactory
        oHSF = oPart.HybridShapeFactory

    End Sub
End Module

窗口布局设置

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

第六步:改造录制的宏

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

Imports MECMOD
Imports HybridShapeTypeLib
Imports INFITF

Public Class Form1
    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        InitCATIAPart(True) 'true表示新建一个part

        Dim XDis As Integer = 0
        For iCount = 1 To Val(TextBox1.Text)

            Dim sketches1 As Sketches = oBody.Sketches
            Dim originElements1 As OriginElements = oPart.OriginElements
            Dim reference1 As Reference = originElements1.PlaneXY
            Dim sketch1 As Sketch = sketches1.Add(reference1)
            Dim factory2D1 As Factory2D = sketch1.OpenEdition()

            Dim circle2D1 As Circle2D = factory2D1.CreateClosedCircle(XDis, 0#, 5.0#)


            Dim constraints1 As Constraints = sketch1.Constraints
            Dim reference2 As Reference = oPart.CreateReferenceFromObject(circle2D1)
            Dim constraint1 = constraints1.AddMonoEltCst(CatConstraintType.catCstTypeRadius, reference2)


            Dim length1 = constraint1.Dimension
            length1.Value = 5.0#
            sketch1.CloseEdition()
            oPart.InWorkObject = sketch1
            oPart.Update()



            Dim hybridShapeDirection1 As HybridShapeDirection = oHSF.AddNewDirectionByCoord(0#, 0#, 0#)
            Dim reference3 As Reference = oPart.CreateReferenceFromObject(sketch1)
            Dim hybridShapeExtrude1 = oHSF.AddNewExtrude(reference3, 20.0#, 0#, hybridShapeDirection1)
            'hybridShapeExtrude1.SymmetricalExtension = 0

            oBody.InsertHybridShape(hybridShapeExtrude1)
            oPart.InWorkObject = hybridShapeExtrude1  '需要加上,不然不会自动更新
            oPart.Update()

            XDis = XDis + Val(TextBox2.Text)
        Next
        oPart.Update()
    End Sub
End Class

第七步:进行测试

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

报错:关于非窗体转换成窗体报错Model1中找不到sub main

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

启动成功

外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传

;