狮猿社CATIA

CATIA VBA:更改工程图链接

2020-04-14  本文已影响0人  锦囊喵
Sub ReLink()

    Dim DrwDocument   As DrawingDocument
    Dim DrwSheets     As drawingSheets
    Dim DrwSheet      As drawingSheet
    Dim DrwView       As DrawingView
    Dim DrwTexts      As DrawingTexts
    Dim Text          As DrawingText
    Dim Fact          As Factory2D
    Dim Point         As Point2D
    Dim Line          As Line2D
    Dim Cicle         As Circle2D
    Dim Selection     As Selection
    Dim GeomElems     As GeometricElements
    Dim Part_name     As String
    Dim Part_name2     As String
    Dim Part_File     As String
    Dim Drawing_name As String
    Dim strFilePath As String
    Dim documents1 As Documents
    Set documents1 = CATIA.Documents
    Dim partDocument1 As PartDocument
    Dim Product1 As ProductDocument

    Set DrwDocument = CATIA.ActiveDocument
    Set DrwSheets = DrwDocument.Sheets
    Set Selection = DrwDocument.Selection
    Set DrwSheet = DrwSheets.ActiveSheet
    Set DrwView = DrwSheet.Views.ActiveView
    Set DrwTexts = DrwView.Texts
    Set Fact = DrwView.Factory2D
    Set GeomElems = DrwView.GeometricElements
    Set MyDrawingDoc = CATIA.ActiveDocument
    MyDrawingDoc.Sheets.Item(1).Activate
    Dim Number_View As Integer
    Dim windows1 As Windows
    Set windows1 = CATIA.Windows

    Drawing_name = CATIA.ActiveWindow.Name
    Number_View = CATIA.ActiveDocument.Sheets.ActiveSheet.Views.Count

    If Number_View > 2 Then

        'Display file open dialog
        strFilePath = CATIA.FileSelectionBox("Escolha o ficheiro que pretende fazer o relink para este desenho", "*.*", CatFileSelectionModeOpen)

        If strFilePath = "" Then
            Exit Sub
        End If

        Dim a As Integer
        Dim b As Integer
        a = InStr(strFilePath, "CATProduct")
        b = InStr(strFilePath, "CATPart")

        If a > 0 Then
            Product1 = documents1.Open(strFilePath)
        End If

        If b > 0 Then
            Set partDocument1 = documents1.Open(strFilePath)
        End If

        Dim Num_Janelas As Integer
        Num_Janelas = windows1.Count
        Dim Janelas_array()

        ReDim Preserve Janelas_array(Num_Janelas)      
        For i = 1 To Num_Janelas
            Janelas_array(i) = windows1.Item(i).Name
            If Janelas_array(i) = Drawing_name Then
                Dim specsAndGeomWindow1 As SpecsAndGeomWindow
                Set specsAndGeomWindow1 = windows1.Item(Janelas_array(i))
                specsAndGeomWindow1.Activate
                Component_display = "Ok"
            End If              
        Next

        For i = 3 To Number_View
            Set DrwView = CATIA.ActiveDocument.Sheets.ActiveSheet.Views.Item(i)
            ' access links collection
            Dim oGenLinks As DrawingViewGenerativeLinks
            Dim linkedDocument
            DrwView.GenerativeLinks.RemoveAllLinks

            If a > 0 Then
                DrwView.GenerativeLinks.AddLink Product1.Product
            End If

            If b > 0 Then
                DrwView.GenerativeLinks.AddLink partDocument1.Product
            End If

            'DrwView.GenerativeLinks.AddLink
        Next

    Else
            MsgBox ("Não existe nehuma vista, para trocar os links")
    End If
End Sub 

https://www.eng-tips.com/viewthread.cfm?qid=426477

上一篇 下一篇

猜你喜欢

热点阅读