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
网友评论