Sub Example_RenameProfile()
    'Этот пример переименовывает существующий профиль.
    'Вы можете видеть переименованный профиль в Options/Profiles
    '
    '*Note: Этот пример полагается на профиль "<<Unnamed Profile>>".
    'Если этот профиль был уже переименован или удален, убедитесь, что изменили 
    'имя SourceProfile к тому профилю, который в настоящее время существует.
    
    Dim ACADPref As AcadPreferencesProfiles
    Dim SourceProfile As String, DestinationProfile As String
    
    'Получите объект параметров профилей
    Set ACADPref = ThisDrawing.Application.preferences.Profiles
    
    'Переименуйте профиль значения по умолчанию
    On Error GoTo ERRORTRAP
    
    SourceProfile = "<<Unnamed Profile>>"
    DestinationProfile = "NEW_PROFILE_NAME"
        
    ACADPref.RenameProfile SourceProfile, DestinationProfile

    MsgBox "Мы только что переименовывали профиль " & SourceProfile & " на " & DestinationProfile
    
    Exit Sub
    
ERRORTRAP:
    If Err.Description <> "" Then
        MsgBox "Профиль '" & SourceProfile & "' не найден, пожалуйста используйте другой исходный профиль."
    End If

End Sub

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