Fica aqui o código.
Sub XOPEN()
'abre referencia em outro desenho
Dim Documento As ZcadDocument
Dim PONTOBASE1 As ZcadPoint
Dim Xreferencia As ZcadEntity
Dim auxiliar As Integer
Dim Ficheiro As String
Dim FicheiroNome As String
On Error Resume Next
ThisDrawing.Utility.GetEntity Xreferencia, PONTOBASE1, "Escolha o Xref a abrir."
If Xreferencia.IsLayout = False Then
If Xreferencia.IsXRef = True Then
Ficheiro = Xreferencia.Path
FicheiroNome = ThisDrawing.Application.ActiveDocument.FullName
If Left(Ficheiro, 1) = "." Then
auxiliar = 0
Do While Mid(FicheiroNome, Len(FicheiroNome) - auxiliar, 1) <> "\" And Mid(FicheiroNome, Len(FicheiroNome) - auxiliar, 1) <> "/"
auxiliar = auxiliar + 1
If Len(FicheiroNome) - auxiliar = 0 Then Exit Sub
Loop
Ficheiro = Mid(FicheiroNome, 1, Len(FicheiroNome) - auxiliar) + Right(Ficheiro, Len(Ficheiro) - 2)
End If
For Each Documento In Documents
If Documento.FullName = Ficheiro Then
MsgBox ("O xref já se encontra aberto.")
Exit Sub
End If
Next Documento
ThisDrawing.Application.Documents.Open (Ficheiro)
End If
End If
End Sub
Obrigado
Sem comentários:
Enviar um comentário