Sub Example_CopyProfile()
    ' Этот пример копирует существующую конфигурацию.
    ' Вы можете видеть новую конфигурацию при Options/Profiles
    '
    ' Этот пример полагается на заданную по умолчанию конфигурацию "<<Unnamed Profile>>".
    ' Если эта конфигурация была уже переименована или удалена,
    ' убедитесь, что изменили название SourceProfile к тому, который в
    ' настоящее время существует.
    
    Dim ACADPref As AcadPreferencesProfiles
    Dim SourceProfile As String, DestinationProfile As String
    
    ' Используйте объект PreferencesProfiles
    Set ACADPref = ThisDrawing.Application.preferences.Profiles
    
    ' Копируйте заданную по умолчанию конфигурацию
    On Error GoTo ERRORTRAP
    
    SourceProfile = "<<Unnamed Profile>>"
    DestinationProfile = "NEW_PROFILE"
    
    ACADPref.CopyProfile SourceProfile, DestinationProfile
    
    MsgBox "Мы только что скопировали существующую конфигурацию " & SourceProfile & " в " & DestinationProfile
    
    Exit Sub
    
ERRORTRAP:
    If Err.Description <> "" Then
        MsgBox "Заданная по умолчанию конфигурация '" & SourceProfile & "' не может быть найдена, пожалуйста используйте другую исходную конфигурацию."
    End If
End Sub

Сайт управляется системой uCoz