[Linetzev]

Я уже много мелочей написал на VBA для себя под AutoCAD. Это в основном простые программки. Только недавно начал программировать формы и в них желательно бы иметь кнопки OPEN и SAVE для работы с файлами. Подскажите как мне реализовать на форме эти кнопки и соответственно работать с текстовыми файлами?

[Олег (jr.)]

Сообщение от Linetzev Я уже много мелочей написал на VBA для себя под AutoCAD. Это в основном простые программки. Только недавно начал программировать формы и в них желательно бы иметь кнопки OPEN и SAVE для работы с файлами. Подскажите как мне реализовать на форме эти кнопки и соответственно работать с текстовыми файлами?

Можно так (проверено только для Windows XP):

Код:

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

Option Explicit
'' Fatty T.O.H () 2006 * all rights removed
Function BrowseForFile(pstrPath, pstrFilter)
Dim objDialog As Object
Dim intResult As Integer
Set objDialog = CreateObject("UserAccounts.CommonDialog")
objDialog.Filter = pstrFilter
objDialog.InitialDir = pstrPath
objDialog.flags = &H4 + &H8 + &H4000
intResult = objDialog.ShowOpen()
BrowseForFile = objDialog.FileName
End Function



Sub test()
Dim p, f, s
p = ThisDrawing.GetVariable("DWGPREFIX")
f = "AutoCAD Files| *.dwg"
s = BrowseForFile(p, f)
MsgBox s
Application.Documents.Open s, False
MsgBox "end open file " & s
'' --> здесь работаешь с файлом
Application.ActiveDocument.SaveAs ("C:\SaveTest.dwg") <--для примера сохраняем здесь
MsgBox "saved as C:\SaveTest.dwg"
Application.ActiveDocument.Close
End Sub

~'J'~

[Linetzev]

Спасибо. Попробую Ваш алгоритм.

[rass]

Спасибо! алгоритм работает, но к сожалению только на Win XP, а как его оживить на Win 7? почемуто на "семерке" CommonDialog не работает (((

[trir]

Код:

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

Public Type OpenFileName
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" _
(pOpenfilename As OpenFileName) As Long

Public Function OpenFile(Filter As String, Extention As String, Optional Directory As String) As String
Dim strTemp As String
Dim OpenFileName As OpenFileName
With OpenFileName
.lStructSize = Len(OpenFileName)
.hwndOwner = ThisDrawing.HWND
.lpstrFilter = Filter & " (" & Extention & ")" & Chr$(0) & Extention & Chr$(0)
.lpstrFile = Space$(254)
.nMaxFile = 255
.lpstrFileTitle = Space$(254)
.nMaxFileTitle = 255
.lpstrInitialDir = Directory
.lpstrTitle = "Выбор Файла"
.flags = 0
If GetOpenFileName(OpenFileName) Then
strTemp = (Trim(.lpstrFile))
OpenFile = Mid(strTemp, 1, Len(strTemp) - 1)
End If
End With
End Function

Вызов как то так

Код:

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

TextBox1.Text = OpenFile("Чертёж", "*.dwg", "c:\")

[rass]

trir спасибо, и ваш код наконец-то заработал у меня на Win7!

[trir]

На x64
ThisDrawing.HWND
надо заменить на
ThisDrawing.HWND32

[Mark_Shneider]

Сообщение от trir На x64 ThisDrawing.HWND надо заменить на ThisDrawing.HWND32

На вин 10 не работает, в чем причина?

----- добавлено через ~9 мин. -----
На 10 винде выдает на участке

Код:

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

Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" _
(pOpenfilename As OpenFileName) As Long

ошибку "The code in this project must be updated for use on 64-bit systems. Please review and update Declare statements and then mark them with the PtrSafe attribute."

[Boxa]

https://forums.autodesk.com/t5/inven...le.language=ru

Могли бы и сами поискать строчку ошибки и имя библиотеки в гугле.

[Mark_Shneider]

Сообщение от Boxa https://forums.autodesk.com/t5/inven...le.language=ru Могли бы и сами поискать строчку ошибки и имя библиотеки в гугле.

Спасибо, но теперь на строчке

Код:

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

.hwndOwner = ThisDrawing.HWND32

выдает method or data member not found.

[trir]

да, была целая статья про это
HWND32 больше нет

[A1111exiy]

Открыть диалог сохранения файла чертежа можно проще:

Код:

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

ThisDrawing.SendCommand "_saveas "

Аналогично для открытия чертежа посылаем команду "_open "
Следующий код сохраняет чертёж, если он уже однажды был сохранён, иначе открывает диалог "Сохранить как...":

Код:

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

    With ThisDrawing
        If .FullName = vbNullString Then
            Dim sss As String
            Dim rrr As Long
            sss = .Name
            rrr = MsgBox(sss & vbNewLine & "Ещё не был сохранён. Сохранить?", vbYesNo + vbQuestion)
            If rrr = vbYes Then
                .SendCommand "_saveas "
            End If
        Else
            .Save
        End If
    End With

Открыть диалог открытия/сохранения для абстрактного файла в autocad сложнее, чем в MSOffice - там есть объект Dialogs.

Код:

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

With Dialogs(wdDialogFileOpen)
    .Name = "*.*"
    .Show
End With

[Artifed]

После поиска проблемы открытия диалоговых окон Save и Open, решил оставить часть кода на форуме, вдруг кому-то пригодится. Работает на Win11, Autocad 2024

Код:

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

Option Explicit
    
    Private lngHwnd As LongPtr
    Public strFilter As String
    Public strTitle As String
    Public strDir As String
    Private blnHideReadOnly As Boolean
    Private blnAllowMulti As Boolean
    Private blnMustExist As Boolean
    Private Const OFN_FILEMUSTEXIST = &H1000
    Private Const OFN_HIDEREADONLY = &H4
    Private Const OFN_ALLOWMULTISELECT = &H200
    Private Const OFN_EXPLORER As Long = &H80000
   
Private Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare PtrSafe Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr

Private Type OPENFILENAME
    lStructSize As Long
    hwndOwner As LongPtr
    hInstance As LongPtr
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long 'LongPtr
    lpfnHook As LongPtr
    lpTemplateName As String
End Type

'------------------------------------------------------------

Public Function ShowOpen(ByVal strDir As String, ByVal strFilter As String, ByVal strTitle As String) As String

    Dim strTemp As String
    Dim udtStruct As OPENFILENAME

    With udtStruct
        .lStructSize = LenB(udtStruct)
        'Use our private variable
        .hwndOwner = lngHwnd
        'Use our private variable
        .lpstrFilter = strFilter
        .lpstrFile = Space$(254)
        .nMaxFile = 255
        .lpstrFileTitle = Space$(254)
        .nMaxFileTitle = 255
        'Use our private variable
        .lpstrInitialDir = strDir
        'Use our private variable
        .lpstrTitle = strTitle
        ' udtStruct.lpstrCustomFilter = "*.*"
        'Ok, here we test our booleans to
        'set the flag
    End With

    If blnHideReadOnly And blnAllowMulti And blnMustExist Then
        udtStruct.flags = OFN_HIDEREADONLY Or _
        OFN_ALLOWMULTISELECT Or OFN_EXPLORER Or OFN_FILEMUSTEXIST
    ElseIf blnHideReadOnly And blnAllowMulti Then
        udtStruct.flags = OFN_ALLOWMULTISELECT _
        Or OFN_EXPLORER Or OFN_HIDEREADONLY
    ElseIf blnHideReadOnly And blnMustExist Then
        udtStruct.flags = OFN_HIDEREADONLY Or OFN_FILEMUSTEXIST
    ElseIf blnAllowMulti And blnMustExist Then
        udtStruct.flags = OFN_ALLOWMULTISELECT Or _
        OFN_EXPLORER Or OFN_FILEMUSTEXIST
    ElseIf blnHideReadOnly Then
        udtStruct.flags = OFN_HIDEREADONLY
    ElseIf blnAllowMulti Then
        udtStruct.flags = OFN_ALLOWMULTISELECT _
        Or OFN_EXPLORER
    ElseIf blnMustExist Then
        udtStruct.flags = OFN_FILEMUSTEXIST
    End If

    If GetOpenFileName(udtStruct) Then
        strTemp = (Trim(udtStruct.lpstrFile))
        ShowOpen = Mid(strTemp, 1, Len(strTemp) - 1)
    End If

End Function

Public Function ShowSave(ByVal strDir As String, ByVal strFilter, ByVal strTitle) As String

    Dim strTemp As String
    Dim udtStruct As OPENFILENAME
    udtStruct.lStructSize = LenB(udtStruct)
    'Use our private variable
    udtStruct.hwndOwner = lngHwnd
    'Use our private variable
    udtStruct.lpstrFilter = strFilter
    udtStruct.lpstrFile = Space$(254)
    udtStruct.nMaxFile = 255
    udtStruct.lpstrFileTitle = Space$(254)
    udtStruct.nMaxFileTitle = 255
    'Use our private variable
    udtStruct.lpstrInitialDir = strDir
    'Use our private variable
    udtStruct.lpstrTitle = strTitle
    If blnMustExist Then
        udtStruct.flags = OFN_FILEMUSTEXIST
    End If

    If GetSaveFileName(udtStruct) Then
        strTemp = (Trim(udtStruct.lpstrFile))
        ShowSave = Mid(strTemp, 1, Len(strTemp) - 1)
    End If

End Function

Public Sub Spec_Open()
Dim Filter As String
Dim InitialDir As String
Dim DialogTitle As String
Dim OutputStr As String
Dim Idcode As String

Filter = "Excel Workbook (*.xlsx)" + Chr$(0) + "*.xlsx" + Chr$(0) + _
"All Files (*.*)" + Chr$(0) + "*.*" + Chr$(0)
InitialDir = "c:\"
DialogTitle = "Open a Settings file"
OutputStr = ShowOpen(InitialDir, Filter, DialogTitle)

If OutputStr = "" Then
MsgBox "Файл не выбран"
End If

MsgBox OutputStr

End Sub

Public Sub Spec_Save()
Dim Filter As String
Dim InitialDir As String
Dim DialogTitle As String
Dim OutputStr As String


'Set objFile = New FileDialogs
Filter = "Drawing Files (*.dwg)" + Chr$(0) + "*.dwg" + Chr$(0) + _
"All Files (*.*)" + Chr$(0) + "*.*" + Chr$(0)
InitialDir = "c:\"
DialogTitle = "Save a Settings file"
OutputStr = ShowSave(InitialDir, Filter, DialogTitle)
MsgBox OutputStr
End Sub