Удалить лишние mslink-и в dgn-файле

Автор: | 20/11/2011

У dgn-файлов есть неприятная (и, увы, непонятная) фишка. Со временем мслинки начинают множиться в неимоверном количестве. При большом количестве объектов это становится проблемой, кою и решает (давно) написанный мной макрос. Публикую, может кому сгодится.
Sub Порядок()
Dim el As element
Dim dblinks() As DatabaseLink
Dim dbl As DatabaseLink
Dim ee As ElementEnumerator
Dim k As Integer
Dim ii As Integer
Dim vsp As Long

Set ee = ActiveModelReference.GetSelectedElements
Do While ee.MoveNext
Set el = ee.Current
If (el.IsGraphical = True) And (el.HasAnyDatabaseLinks = True) Then
dblinks = el.GetDatabaseLinks(msdDatabaseLinkageOdbc)

If (UBound(dblinks) > -1) Then

vsp = 0
k = UBound(dblinks) — LBound(dblinks)
For ii = LBound(dblinks) To UBound(dblinks)
Write #2, dblinks(ii).Mslink
If (dblinks(ii).Mslink > vsp) Then
vsp = dblinks(ii).Mslink
End If
Next ii

If (k > -1) Then
el.RemoveAllDatabaseLinks
el.Rewrite
Set dbl = CreateDatabaseLink(vsp, 0, msdDatabaseLinkageOdbc, True, 1)
el.AddDatabaseLink dbl
el.Rewrite
End If
End If
End If
Loop

End Sub

Добавить комментарий

Ваш e-mail не будет опубликован. Обязательные поля помечены *

Это не спам.