[sergeytr]

Добрый день всем!
(VBA)
переменная AutoCAD в которой можно было-бы сохранить значение для исползования в последующих вызовах AutoCAD.
пожалуйста подскжите место в AutoCAD где можно положить свои данные независимо от DWG
:?:

[Евгений А.]

Работайте с реестром - он для этих целей и создан

[sergeytr]

????? если можно подробней как ц ним работать? :roll:

[Кулик Алексей aka kpblc]

Если именно через VBA, то аналогично такому, думаю:

Код:

[Выделить все]

Declare Function RegCloseKey Lib "advapi32.dll" (ByVal Hkey As Long) As Long
Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String) As Long
Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal Hkey As Long, ByVal lpValueName As String) As Long
Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal Hkey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal Hkey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Public Const REG_SZ = 1                         ' Unicode nul terminated string
Public Const REG_DWORD = 4                      ' 32-bit number

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const ERROR_SUCCESS = 0&

Private lResult As Long
Private lValueType As Long
Private lBuf As Long
Private lDataBufSize As Long
Private r As Long
Private keyhand As Long

Public Sub savekey(Hkey As Long, strPath As String)
Dim keyhand&
r = RegCreateKey(Hkey, strPath, keyhand&)
r = RegCloseKey(keyhand&)
End Sub

Public Function getstring(Hkey As Long, strPath As String, strValue As String)
Dim keyhand As Long
Dim datatype As Long
Dim lResult As Long
Dim strBuf As String
Dim lDataBufSize As Long
Dim intZeroPos As Integer
r = RegOpenKey(Hkey, strPath, keyhand)
lResult = RegQueryValueEx(keyhand, strValue, 0&, lValueType, ByVal 0&, lDataBufSize)
If lValueType = REG_SZ Then
    strBuf = String(lDataBufSize, " ")
    lResult = RegQueryValueEx(keyhand, strValue, 0&, 0&, ByVal strBuf, lDataBufSize)
    If lResult = ERROR_SUCCESS Then
        intZeroPos = InStr(strBuf, Chr$(0))
        If intZeroPos > 0 Then
            getstring = Left$(strBuf, intZeroPos - 1)
        Else
            getstring = strBuf
        End If
    End If
End If
End Function

Public Sub savestring(Hkey As Long, strPath As String, strValue As String, strdata As String)
Dim keyhand As Long
Dim r As Long
r = RegCreateKey(Hkey, strPath, keyhand)
r = RegSetValueEx(keyhand, strValue, 0, REG_SZ, ByVal strdata, Len(strdata))
r = RegCloseKey(keyhand)
End Sub

Function GetDword(ByVal Hkey As Long, ByVal strPath As String, ByVal strValueName As String) As Long
Dim lResult As Long
Dim lValueType As Long
Dim lBuf As Long
Dim lDataBufSize As Long
Dim r As Long
Dim keyhand As Long
r = RegOpenKey(Hkey, strPath, keyhand)
lDataBufSize = 4
lResult = RegQueryValueEx(keyhand, strValueName, 0&, lValueType, lBuf, lDataBufSize)
If lResult = ERROR_SUCCESS Then
    If lValueType = REG_DWORD Then
        GetDword = lBuf
    End If
End If
r = RegCloseKey(keyhand)
End Function

Function SaveDword(ByVal Hkey As Long, ByVal strPath As String, ByVal strValueName As String, ByVal lData As Long)
    Dim lResult As Long
    Dim keyhand As Long
    Dim r As Long
    r = RegCreateKey(Hkey, strPath, keyhand)
    lResult = RegSetValueEx(keyhand, strValueName, 0&, REG_DWORD, lData, 4)
    r = RegCloseKey(keyhand)
End Function

Public Function DeleteKey(ByVal Hkey As Long, ByVal strKey As String)
Dim r As Long
r = RegDeleteKey(Hkey, strKey)
End Function

Public Function DeleteValue(ByVal Hkey As Long, ByVal strPath As String, ByVal strValue As String)
Dim keyhand As Long
r = RegOpenKey(Hkey, strPath, keyhand)
r = RegDeleteValue(keyhand, strValue)
r = RegCloseKey(keyhand)
End Function

Это кусок моей dll, так что если что-то не сработает, прошу простить.
Можешь поискать по словам RegCloseKey, RegCreateKey, RegDeleteKey, RegDeleteValue, RegOpenKey, RegQueryValueEx, RegSetValueEx.
Хочу попутно выразить благодарность SmeL'у - без него я б мало чего смог

[Sven]

А еще можно в ini файле хранить.

Код:

[Выделить все]

'Example by Antti Hдkkinen (antti@theredstar.f2s.com)
'Visit his website at http://www.theredstar.f2s.com/
'require variable declaration
Option Explicit

'declares for ini controlling
Private Declare Function GetPrivateProfileSection Lib "kernel32" Alias "GetPrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileSection Lib "kernel32" Alias "WritePrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpString As String, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long

'when form is loaded
Private Sub Form_Load()

'if error occures resume still
On Error Resume Next

'local variables
Dim File As String, OFLen As Double, _
    Str As String

'set our varibles
File = "C:\temp.txt"
OFLen = FileLen(File)

'write few example sections:
WriteIniSection File, "Test1", ""
WriteIniSection File, "Test2", "Here shoud be found some text"

'write few ini strings
WriteIni File, "Test3", "Ini1", "This is ini 1"
WriteIni File, "Test1", "Ini2", "This is ini 2"

'inform we're written the data
MsgBox Format((FileLen(File) - OFLen) / 1024, "0.00") & " KB data written to " & Chr(34) & File & Chr(34)

'read the ini file
Str = Str & "Test2 section: " & vbTab & ReadIniSection(File, "Test2") & vbCrLf
Str = Str & "Test1 section: " & vbTab & ReadIniSection(File, "Test1") & vbCrLf
Str = Str & "Ini1 string: " & vbTab & ReadIni(File, "Test3", "Ini1") & vbCrLf
Str = Str & "Ini2 string: " & vbTab & ReadIni(File, "Test1", "Ini2") & vbCrLf

'show data
MsgBox Str

'end application
End

End Sub

'// INI CONTROLLING PROCEDURES

'reads ini string
Public Function ReadIni(Filename As String, Section As String, Key As String) As String
Dim RetVal As String * 255, v As Long
v = GetPrivateProfileString(Section, Key, "", RetVal, 255, Filename)
ReadIni = Left(RetVal, v - 1)
End Function

'reads ini section
Public Function ReadIniSection(Filename As String, Section As String) As String
Dim RetVal As String * 255, v As Long
v = GetPrivateProfileSection(Section, RetVal, 255, Filename)
ReadIniSection = Left(RetVal, v - 1)
End Function

'writes ini
Public Sub WriteIni(Filename As String, Section As String, Key As String, Value As String)
WritePrivateProfileString Section, Key, Value, Filename
End Sub

'writes ini section
Public Sub WriteIniSection(Filename As String, Section As String, Value As String)
WritePrivateProfileSection Section, Value, Filename
End Sub

[sergeytr]

очень сложно, ...попробую понять?!
мне хотелось чего-нибудь типа USERR1 , только с сохранением в реестре!
и обойтись стандартными
GetVariable
SetVariable
может быть есть переменная изменение которой не помешает работе?? :cry:

[Евгений А.]

В Лиспе это делается крайне легко, одной коммандой запись и одной - чтение! Наверняка в VBA тоже всё довольно просто, лезьте в справку!!!

[Кулик Алексей aka kpblc]

В лиспе эти функции на самом деле, насколько я знаю, написаны на C++, и все равно используют те же самые API, что и VB(A). Варианты предоставлены, теперь вопрос выбора

[Эдуард]

В лиспе есть функции setcfg , getcfg , которые записывают и читают данные из файла acad.cfg - однако никогда ими не пользовался потому-что
1. Нечего создавать помойку из этого файла
2.Никогда не возникала потребность сохранять постоянно и для всех рисунков значения каких-то переменных.

То-же самое касается и реестра.
Может и вам не стоит? Объяснили-бы лучше для чего это нужно.

[AY]

Сообщение от kpblc В лиспе эти функции на самом деле, насколько я знаю, написаны на C++, и все равно используют те же самые API, что и VB(A)

Ну если уж заниматься буквоедством, то можно смело утверждать, что все функции (встроенные) в лиспе написаны на С/С++ равно как все программы тем или иным способом использую API :)

[Евгений А.]

Сообщение от Эдуард 1. Нечего создавать помойку из этого файла 2.Никогда не возникала потребность сохранять постоянно и для всех рисунков значения каких-то переменных....То-же самое касается и реестра.

Совершенно с вами согласен, если нет необходимости - "НЕ ПРИКАСАТЬСЯ -УБЪЁТ". А вот когда программе надо сохранить какие-то параметры, или другие не объёмные данные, то удобнее реестра, пока ничего не знаю. Повторюсь, Реестр для этого и придуман - сохранение парметров!!!
В Лиспе :
запись 777 :

Код:

[Выделить все]

Command: (vl-registry-write "HKEY_CURRENT_USER\\Test" "" 777)
777

и чтение:

Код:

[Выделить все]

Command:  (vl-registry-read "HKEY_CURRENT_USER\\Test")
777

По моему проще некуда.

[ShaggyDoc]

Независимо от того, кто как "любит" при работе в Microsoft Windows надо придерживаться правил, установленных Microsoft. Иначе программа может оказаться нерабочей.

1. Все настройки (переменные) для текущего пользователя и конкретной программы сохранять в реестре (HKCU), в ветви своей программы.

2. Настройки, хранящиеся в файлах (хотя бы в INI), записывать в файлы, расположенные в Documents And Settings (Profiles)\%USER_NAME%\%APP_NAME%

И нигде более.

3. Настройки для всех пользователей - в реестре в HKLM. Запись - администратором, чтение - всеми. Настройки, хранящиеся в файлах (хотя бы в INI), записывать в файлы, расположенные в Documents And Settings (Profiles)\All Users\%APP_NAME%

4. Настройки, относящиеся к конкретному файлу - внутри самого DWG, в словарях.

И в VBA и в LISP все для этого есть.

Решаясь на любую запись в файл надо быть готовым, что к нему может не оказаться доступа, что он может быть создан одним пользователем (администратором), а писать будет другой.