| | | Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte |
Autor
|
Thema: Open & Save-Dialog für Textdatei in vba (4562 mal gelesen)
|
sarotti Mitglied Bauingenieur
Beiträge: 74 Registriert: 14.07.2005 AutoCad 2022 64Bit Windows 10-64Bit mit 32 GByte
|
erstellt am: 19. Feb. 2014 16:31 <-- editieren / zitieren --> Unities abgeben:
Hallo liebe Leute im Forum, mit der Umstellung auf AutoCAD 2014 und Windows 8 64-bit ist das Command-Dialog Steuerelement entfallen. Ich habe nun das Problem das ich Koordinaten über ein Dialogfenster (Laden der Datei) aus einer Textdatei in AutoCAD einlesen möchte, hierfür habe ich im Internet folgende Lösung gefunden: 'AutoCAD 2014 64-Bit Version 'Using the SendCommand method, send getfiled AutoLISP expressions to the AutoCAD command line. 'Set the return value to a user-defined system variable USERS1. ThisDrawing.SendCommand "(setvar " & """users1""" & "(getfiled " & """Datei auswählen""" & """c:/program files/acad2014/"""& """txt"""& "8)) " 'Use the GetVariable method to retrieve this system variable to store the selected file name Pfad = ThisDrawing.GetVariable("users1") Das Speichern von Koordinaten aus AutoCAD in eine Textdatei möchte ich gerne auch über eine Dialogbox zur Auswahl des Speicherortes zur Verfügung stellen. Leider bekomm ich diese einfach nicht hin. Hat jemand von euch eine Idee wie ich das umsetzen kann? Danke im voraus. Gruß Sarotti Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Soldnerkugel Mitglied
Beiträge: 131 Registriert: 29.01.2010 Win 7, AutoCAD Civil 3D 2015, SketchUp, CarlsonSurvCE
|
erstellt am: 20. Feb. 2014 09:22 <-- editieren / zitieren --> Unities abgeben: Nur für sarotti
Option Explicit Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" ( _ pOpenfilename As OPENFILENAME) As Long Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _ ByVal lpClassName As String, _ ByVal lpWindowName As String) As Long Private Const OFN_READONLY = &H1 Private Const OFN_OVERWRITEPROMPT = &H2 Private Const OFN_HIDEREADONLY = &H4 Private Const OFN_NOCHANGEDIR = &H8 Private Const OFN_SHOWHELP = &H10 Private Const OFN_ENABLEHOOK = &H20 Private Const OFN_ENABLETEMPLATE = &H40 Private Const OFN_ENABLETEMPLATEHANDLE = &H80 Private Const OFN_NOVALIDATE = &H100 Private Const OFN_ALLOWMULTISELECT = &H200 Private Const OFN_EXTENSIONDIFFERENT = &H400 Private Const OFN_PATHMUSTEXIST = &H800 Private Const OFN_FILEMUSTEXIST = &H1000 Private Const OFN_CREATEPROMPT = &H2000 Private Const OFN_SHAREAWARE = &H4000 Private Const OFN_NOREADONLYRETURN = &H8000& Private Const OFN_NOTESTFILECREATE = &H10000 Private Const OFN_NONETWORKBUTTON = &H20000 Private Const OFN_NOLONGNAMES = &H40000 ' force no long names for 4.x modules Private Const OFN_EXPLORER = &H80000 ' new look commdlg Private Const OFN_NODEREFERENCELINKS = &H100000 Private Const OFN_LONGNAMES = &H200000 Private Const GC_CLASSNAMEMSWORD = "OpusApp" Private 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 Sub prcShowOpenDialog() Dim OFName As OPENFILENAME With OFName .lStructSize = Len(OFName) .hwndOwner = FindWindow(GC_CLASSNAMEMSWORD, vbNullString) .hInstance = 0 .lpstrFilter = "Alle Dateien (*.*)" & Chr$(0) & "*.*" & Chr$(0) .lpstrFile = Space$(254) .nMaxFile = 255 .lpstrFileTitle = Space$(254) .nMaxFileTitle = 255 .lpstrInitialDir = "C:\ .lpstrTitle = "Open File" .flags = OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY Or OFN_PATHMUSTEXIST End With If GetOpenFileName(OFName) Then ' 'MsgBox "File to Open: " & Trim$(OFName.lpstrFile) Else Exit Sub MsgBox "Cancel was pressed" End If End Sub Hilft dir das evtl. weiter? hab' ich jetzt mal so ungeprüft reingestellt, benutze ich nicht mit AutoCAD VBA sondern mit Excel VBA (und hab' ich irgendwo aus dem Internet "geklaut"). Allerdings ersetzen diesen Zeilen den sog. "Common Dialog" (falls du den gemeint hast), auf jeden Fall kann man damit prima Dateien öffnen. Dateien damit speichern habe ich noch nicht ausprobiert.
------------------
http://www.stupidedia.org/stupi/Rechter_Winkel Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
CADmium Moderator Maschinenbaukonstrukteur
Beiträge: 13508 Registriert: 30.11.2003 ACAD 2008 Mechanical
|
erstellt am: 20. Feb. 2014 09:29 <-- editieren / zitieren --> Unities abgeben: Nur für sarotti
|
sarotti Mitglied Bauingenieur
Beiträge: 74 Registriert: 14.07.2005 AutoCad 2022 64Bit Windows 10-64Bit mit 32 GByte
|
erstellt am: 20. Feb. 2014 14:13 <-- editieren / zitieren --> Unities abgeben:
Hallo Soldnerkugel, hallo CADmium, vielen Dank für eure Hilfe!!! Soldnerkugel: Ich hab dein Listing leider noch nicht zum Laufen bekommen. Bei Declare will der Compiler noch ein ptrSafe haben und anschließend wird leider kein Auswahlfenster angezeigt, sondern das Programm läuft in der If GetOpenFileName(OFName) ins Exit Sub. Das Listung hab ich jetzt auch im Internet gefunden aber die 3 Seiten noch nicht richtig durchblickt wo der große Unterschied ist zu deiner Kurzform. Außer der 32-Bit-Abfrage. CADmium: Toll wenn sich einer mit Lisp auskennt!! Vielleicht schau ich da in Zukunft doch mal rein. Mit dem Flag = 5 läuft mein Programm jetzt so wie es seinen soll und das ganze mit nur einer Zeile! Ich hab die ganze Zeit nach "save..." gesucht, statt die 8 zu hinterfragen. Nochmals Dank euch beiden. Gruß Sarotti Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Soldnerkugel Mitglied
Beiträge: 131 Registriert: 29.01.2010 Win 7, AutoCAD Civil 3D 2015, SketchUp, CarlsonSurvCE
|
erstellt am: 20. Feb. 2014 14:22 <-- editieren / zitieren --> Unities abgeben: Nur für sarotti
hm, grad nochmal probiert, bei mir läuft's (in excel). Aber evtl. hat's ja doch was geholfen, wenn du das dann im Internet finden konntest. ------------------
http://www.stupidedia.org/stupi/Rechter_Winkel Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
sarotti Mitglied Bauingenieur
Beiträge: 74 Registriert: 14.07.2005 AutoCad 2022 64Bit Windows 10-64Bit mit 32 GByte
|
erstellt am: 21. Feb. 2014 08:18 <-- editieren / zitieren --> Unities abgeben:
Nach meinem Kenntnisstand sind die Office-Anwendungen alles 32-Bit Programme. Daher läuft auch das VBA in Excel als 32-Bit Anwendung. Unter AutoCAD 2014 64-Bit gibt es die 64-Bit Variante von VBA (Version 7.1) und zwischen diesen Versionen gibt es kleine aber feine Unterschiede die einem das Leben erschweren (siehe PtrSafe bei Declare). Gruß Sarotti Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Soldnerkugel Mitglied
Beiträge: 131 Registriert: 29.01.2010 Win 7, AutoCAD Civil 3D 2015, SketchUp, CarlsonSurvCE
|
erstellt am: 21. Feb. 2014 08:32 <-- editieren / zitieren --> Unities abgeben: Nur für sarotti
ja, zwischen 32bit VBA und 64bit VBA gibt's Unterschiede. ist zwar jetzt off topic, aber: hast du evtl. eine Ahnung, ob es online irgendwie eine Übersicht gibt, was da alles für Unterschiede sind? ich hab' schonmal gesucht, bin aber da immer nur auf einzelne Begriffe gestossen, ich wäre an einer "Komplett-Übersicht" interessiert, da ich meine VBA Makros so langsam mal nach 64bit portieren will. ------------------
http://www.stupidedia.org/stupi/Rechter_Winkel Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
..... Mitglied
Beiträge: 433 Registriert: 01.07.2011
|
erstellt am: 21. Feb. 2014 10:05 <-- editieren / zitieren --> Unities abgeben: Nur für sarotti
|
bccad Mitglied
Beiträge: 57 Registriert: 02.11.2009
|
erstellt am: 26. Feb. 2014 10:31 <-- editieren / zitieren --> Unities abgeben: Nur für sarotti
Zitat: ... da ich meine VBA Makros so langsam mal nach 64bit portieren will.
Hallo, da es langfristig immer schwieriger wird VBA am Leben zu erhalten würde ich dir raten auf VB.Net umzusteigen. Da hast du solche Probleme nicht mehr. Ich hab das auch gemacht als wir von XP auf Win7-64 umgestiegen sind. War am Anfang etwas holprig, aber jetzt will ich nicht mehr zurück Bernd Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
sarotti Mitglied Bauingenieur
Beiträge: 74 Registriert: 14.07.2005 AutoCad 2022 64Bit Windows 10-64Bit mit 32 GByte
|
erstellt am: 27. Feb. 2014 08:06 <-- editieren / zitieren --> Unities abgeben:
Hallo bccad, ich hab da mal eine Verständnisfrage zu VB und AutoCAD. Wenn ich das Video auf der Homepage von Autodesk richtig verstehe, dann greift man über das ObjectARX for AutoCAD mit VB auf AutoCAD zu. Was mich dabei stört ist, das es anscheinend für jede neuen Version von AutoCAD ein neues ObjektARX-Paket gibt. Für mich bedeutet diese, das eine Anwendung die für die Version 2013 geschrieben wurde, für die Version 2014 und ff überarbeitet werden muss. Ist das richtig? Der Aufwand wäre mir dann zu groß. Gruß Sarotti Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
cadffm Ehrenmitglied V.I.P. h.c. 良い精神
Beiträge: 21533 Registriert: 03.06.2002 System: F1 und Google
|
erstellt am: 27. Feb. 2014 08:08 <-- editieren / zitieren --> Unities abgeben: Nur für sarotti
IMO: DWGversion, nicht AutoCADversion, also nicht jedes Jahr, aber alle drei Jahre. und .net so wie so für jeder AutoCADversion eine dll - sorry, war vom Thema abgekommen. ------------------ CAD on demand GmbH - Beratung und Programmierung rund um AutoCAD [Diese Nachricht wurde von cadffm am 27. Feb. 2014 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
bccad Mitglied
Beiträge: 57 Registriert: 02.11.2009
|
erstellt am: 27. Feb. 2014 09:39 <-- editieren / zitieren --> Unities abgeben: Nur für sarotti
Zitat:
Was mich dabei stört ist, das es anscheinend für jede neuen Version von AutoCAD ein neues ObjektARX-Paket gibt. Für mich bedeutet diese, das eine Anwendung die für die Version 2013 geschrieben wurde, für die Version 2014 und ff überarbeitet werden muss.Ist das richtig?
Hallo Sarotti, es stimmt zwar das es für jede ACAD-Version ein eigenes Arx-Paket gibt. Das heist aber nicht das du jedesmal dein Programm überarbeiten musst. Du musst nur die Verweise auf die Mgd.dll und zwei weitere Dateien ändern und das Programm neu kompilieren. (Auch getrennt nach 32 und 64 Bit) Das ist zwar lästig, aber die Vorteile überwiegen trotzdem. Mfg, Bernd
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Soldnerkugel Mitglied
Beiträge: 131 Registriert: 29.01.2010 Win 7, AutoCAD Civil 3D 2015, SketchUp, CarlsonSurvCE
|
erstellt am: 28. Mai. 2014 11:26 <-- editieren / zitieren --> Unities abgeben: Nur für sarotti
der Vollständigkeit halber: Option Explicit '''' Deklaration der Funktionen für Aufruf der WinAPI ' Private gilt nur in diesem Modul Private Declare PtrSafe Function GetSaveFileName Lib "comdlg32" Alias _ "GetSaveFileNameA" (lpOpenfilename As OpenFilename) As Long Private Declare PtrSafe Function GetOpenFileName Lib "comdlg32" Alias _ "GetOpenFileNameA" (lpOpenfilename As OpenFilename) As Long Private Declare PtrSafe Function CommDlgExtendedError Lib _ "comdlg32" () As Integer Private Declare PtrSafe Function GetActiveWindow Lib "user32" () _ As Long '''' Deklaration für Hilfsvariablen für WINAPI ' Datentyp zur Übergabe von Parametern 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 Private Const MAX_PATH = 260 ' Konstanten für die Steuerung des Dialog Private Const OFN_ALLOWMULTISELECT = &H200 'Zeigt ein Dialogfeld mit der Möglichkeit, mehrere Dateien 'auszuwählen. In diesem Fall enthält lpstrFile den Pfad und 'anschließend alle Dateinamen. 'nFileOffset zeigt auf den Index des ersten Dateinamens nach 'der Pfadangabe. 'lpstrFile enthält alle Dateinamen durch Chr$(0) getrennt. 'Am Ende folgt ein zweites Chr$(0). Bei alten Win-3.x- 'Dialoge) sind die Dateinamen durch Leerzeichen getrennt. 'Diese Variante kennt keine langen Dateinamen. Private Const OFN_CREATEPROMPT = &H2000 'Zeigt eine Meldung, wenn die Datei nicht existiert und 'fragt den Anwender, ob sie erzeugt werden soll. Private Const OFN_ENABLEHOOK = &H20 'Aktiviert die Rückruffunktion lpfnHook. Private Const OFN_ENABLETEMPLATE = &H40 'Aktiviert die Dialogfeldvorlage. Private Const OFN_ENABLETEMPLATEHANDLE = &H80 'Aktiviert die Dialogfeldvorlage. Private Const OFN_EXPLORER = &H80000 'Nutzt Explorer-Dialoge. Diese Einstellung ist die Vorgabe, 'selbst wenn Sie dieses Flag nicht angeben. Für alte 'Win-3.x-Dialoge müssen Sie das Flag löschen. 'Sie müssen es in den folgenden Fällen setzen: '- bei OFN_ALLOWMULTISELECT. '- wenn Sie Dialogfeldvorlagen und Rückruffunktionen benutzen. Private Const OFN_EXTENSIONDIFFERENT = &H400& 'Gibt an, dass der Anwender einen Dateinamen mit einer 'anderen Erweiterung als lpstrDefExt eingeben kann. Private Const OFN_FILEMUSTEXIST = &H1000 'Gibt an, dass der Anwender nur die Namen von existierenden 'Dateien eingeben kann. Andernfalls wird eine Warnmeldung 'ausgegeben. 'OFN_PATHMUSTEXIST muß ebenfalls gesetzt werden. Private Const OFN_HIDEREADONLY = &H4& 'Versteckt das Kontrollkästchen "Nur lesen". Private Const OFN_LONGNAMES = &H200000 'Aktiviert die Unterstützung von langen Dateinamen in den 'alten Win-3.x-Dialogen. Private Const OFN_NOCHANGEDIR = &H8& 'Stellt das ursprüngliche Verzeichnis bei Ende des Dialoges 'wieder her, wenn der Anwender anderes Verzeichnis 'eingestellt hat. Private Const OFN_NODEREFERENCELINKS = &H100000 'Weist das Dialogfeld an, bei einer markierten Verknüpfung 'Namen und Pfad der Verknüpungsdatei zurückzugeben, anstatt 'Namen und Pfad der Datei, auf die die Verknüpfung verweist. Private Const OFN_NOLONGNAMES = &H40000 'Deaktiviert die Unterstützung von langen Dateinamen in den 'alten Win-3.x-Dialogen. Private Const OFN_NONETWORKBUTTON = &H20000 'Versteckt die Schaltfläche "Netzwerk". Private Const OFN_NOTESTFILECREATE = &H10000 'Gibt an, dass keine Testdatei erzeugt wird, bevor der 'Dialog endet. In diesem Fall überprüft das Dialogfeld nicht 'auf Schreibschutz, Platzmangel auf dem Datenträger oder 'korrekten Netzwerkzugriff. Private Const OFN_OVERWRITEPROMPT = &H2& 'Gibt im Dialog "Speichern" eine Warnmeldung aus, wenn die 'Datei bereits existiert und durch das Speichern 'überschrieben wird. Private Const OFN_PATHMUSTEXIST = &H800 'Gibt an, dass der Anwender nur die Namen von existierenden 'Verzeichnissen eingeben kann. Andernfalls wird eine 'Warnmeldung ausgegeben. Private Const OFN_READONLY = &H1 'Gibt an, das das Kontrollkästchen "Nur Lesen" angekreuzt 'ist, wenn der Dialog angezeigt wird. Private Const OFN_SHAREAWARE = &H4000 'Gibt an, dass die Funktion fehlschlägt, wenn ein 'Netzwerkfehler auftritt. Private Const OFN_SHAREFALLTHROUGH = 2 Private Const OFN_SHAREWARN = 0 Private Const OFN_SHARENOWARN = 1 Private Const OFN_SHOWHELP = &H10 'Zeigt im Dialogfeld den Hilfe-Schalter an. hwndOwner muß auf 'ein Fenster zeigen, das die Hilfe anzeigen kann. Explorer- 'Dialoge senden die Nachricht CDN_HELP an die Rückruffunktion. Public Function GetSaveName(ByVal Filter$, ByVal DefExt$, _ ByVal InitialDir$, ByVal DialogTitle As String, ByVal InitFilename As String) As String Dim OFN As OpenFilename Dim Temp$ Dim n As Integer 'Bestimmen der Optionen für den Dialog With OFN 'Größe der Struktur festlegen .lStructSize = Len(OFN) 'Das aktive Fenster (AutoCAD) wird zum Besitzer des Dialogs .hWndOwner = GetActiveWindow() 'Der Filtzer wird vorbereitet .lpstrFilter = Replace(Filter$, "|", vbNullChar) 'Speicher reservieren für kompletten Pfad .lpstrFile = InitFilename & String$(700 - Len(InitFilename), vbNullChar) 'Größe des reservierten Speichers angeben .nMaxFile = 700 'Speicher reservieren für Dateinamen .lpstrFileTitle = String$(MAX_PATH, vbNullChar) 'Größe des reservierten Speichers angeben .nMaxFileTitle = MAX_PATH 'Das Vorgabeverzeichnis bestimmen .lpstrInitialDir = InitialDir$ & vbNullChar 'Der Titel des Dialoges .lpstrTitle = DialogTitle & vbNullChar 'Optionen bestimmen .Flags = OFN_EXTENSIONDIFFERENT Or _ OFN_NOCHANGEDIR Or OFN_OVERWRITEPROMPT _ Or OFN_HIDEREADONLY 'Standarderweiterung für die Dateien bestimmen .lpstrDefExt = DefExt$ End With If GetSaveFileName(OFN) Then Temp$ = OFN.lpstrFile 'Alles nach dem NULL-Zeichen verwerfen n = InStr(Temp$, vbNullChar) If n > 1 Then GetSaveName = Left$(Temp$, n - 1) Else GetSaveName = "" End If Else GetSaveName = "" End If End Function Public Function GetOpenName(ByVal Filter$, ByVal DefExt$, _ ByVal InitialDir$, ByVal DialogTitle As String, ByVal InitFilename As String) As String Dim OFN As OpenFilename Dim Temp$ Dim n As Integer 'Bestimmen der Optionen für den Dialog With OFN 'Größe der Struktur festlegen .lStructSize = Len(OFN) 'Das aktive Fenster (AutoCAD) wird zum Besitzer des Dialogs .hWndOwner = GetActiveWindow() 'Der Filtzer wird vorbereitet .lpstrFilter = Replace(Filter$, "|", vbNullChar) 'Speicher reservieren für kompletten Pfad .lpstrFile = InitFilename & String$(700 - Len(InitFilename), vbNullChar) 'Größe des reservierten Speichers angeben .nMaxFile = 700 'Speicher reservieren für Dateinamen .lpstrFileTitle = String$(MAX_PATH, vbNullChar) 'Größe des reservierten Speichers angeben .nMaxFileTitle = MAX_PATH 'Das Vorgabeverzeichnis bestimmen .lpstrInitialDir = InitialDir$ & vbNullChar 'Der Titel des Dialoges .lpstrTitle = DialogTitle & vbNullChar 'Optionen bestimmen .Flags = OFN_EXTENSIONDIFFERENT Or _ OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST 'Standarderweiterung für die Dateien bestimmen .lpstrDefExt = DefExt$ End With If GetOpenFileName(OFN) Then Temp$ = OFN.lpstrFile 'Alles nach dem NULL-Zeichen verwerfen n = InStr(Temp$, vbNullChar) If n > 1 Then GetOpenName = Left$(Temp$, n - 1) Else GetOpenName = "" End If Else GetOpenName = "" End If End Function ...so funktioniert der Dialog bei mir in VBA (C3D 2015) ------------------
http://www.stupidedia.org/stupi/Rechter_Winkel Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
sarotti Mitglied Bauingenieur
Beiträge: 74 Registriert: 14.07.2005 AutoCad 2022 64Bit Windows 10-64Bit mit 32 GByte
|
erstellt am: 28. Mai. 2014 19:47 <-- editieren / zitieren --> Unities abgeben:
Hallo Soldnerkugel, ich mach da wohl irgendetwas falsch. Hab einen Code in AutoCAD 2014 64-Bit in ein VBA-Modul kopiert, anschließend eine Form angelegt mit einem Button drauf. Den Button mit folgendem Code belegt: Dim Antwort As Variant Antwort = GetOpenName("*.*", ".tmp", "f:\", "Datei öffnen", "") Die Funktion wird durchlaufen, zeigt aber kein Dialogmenü an. Folglich kann ich nichts auswählen. Irgendwas mach ich beim Aufruf wohl falsche! Gruß Sarotti Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Soldnerkugel Mitglied
Beiträge: 131 Registriert: 29.01.2010 Win 7, AutoCAD Civil 3D 2015, SketchUp, CarlsonSurvCE
|
erstellt am: 29. Mai. 2014 19:58 <-- editieren / zitieren --> Unities abgeben: Nur für sarotti
probier's mal hiermit: Option Explicit
'''' Deklaration der Funktionen für Aufruf der WinAPI ' Private gilt nur in diesem Modul Private Declare PtrSafe Function GetSaveFileName Lib "comdlg32.dll" Alias _ "GetSaveFileNameA" (lpOpenfilename As OpenFilename) As Long Private Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" Alias _ "GetOpenFileNameA" (lpOpenfilename As OpenFilename) As Long ' String vs long Private Declare PtrSafe Function CommDlgExtendedError Lib _ "comdlg32" () As Integer Private Declare PtrSafe Function GetActiveWindow Lib "user32" () _ As Long '''' Deklaration für Hilfsvariablen für WINAPI ' Datentyp zur Übergabe von Parametern 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 lpfnHook As LongPtr lpTemplateName As String End Type Private Const MAX_PATH = 260 ' Konstanten für die Steuerung des Dialog Private Const OFN_ALLOWMULTISELECT = &H200 'Zeigt ein Dialogfeld mit der Möglichkeit, mehrere Dateien 'auszuwählen. In diesem Fall enthält lpstrFile den Pfad und 'anschließend alle Dateinamen. 'nFileOffset zeigt auf den Index des ersten Dateinamens nach 'der Pfadangabe. 'lpstrFile enthält alle Dateinamen durch Chr$(0) getrennt. 'Am Ende folgt ein zweites Chr$(0). Bei alten Win-3.x- 'Dialoge) sind die Dateinamen durch Leerzeichen getrennt. 'Diese Variante kennt keine langen Dateinamen. Private Const OFN_CREATEPROMPT = &H2000 'Zeigt eine Meldung, wenn die Datei nicht existiert und 'fragt den Anwender, ob sie erzeugt werden soll. Private Const OFN_ENABLEHOOK = &H20 'Aktiviert die Rückruffunktion lpfnHook. Private Const OFN_ENABLETEMPLATE = &H40 'Aktiviert die Dialogfeldvorlage. Private Const OFN_ENABLETEMPLATEHANDLE = &H80 'Aktiviert die Dialogfeldvorlage. Private Const OFN_EXPLORER = &H80000 'Nutzt Explorer-Dialoge. Diese Einstellung ist die Vorgabe, 'selbst wenn Sie dieses Flag nicht angeben. Für alte 'Win-3.x-Dialoge müssen Sie das Flag löschen. 'Sie müssen es in den folgenden Fällen setzen: '- bei OFN_ALLOWMULTISELECT. '- wenn Sie Dialogfeldvorlagen und Rückruffunktionen benutzen. Private Const OFN_EXTENSIONDIFFERENT = &H400& 'Gibt an, dass der Anwender einen Dateinamen mit einer 'anderen Erweiterung als lpstrDefExt eingeben kann. Private Const OFN_FILEMUSTEXIST = &H1000 'Gibt an, dass der Anwender nur die Namen von existierenden 'Dateien eingeben kann. Andernfalls wird eine Warnmeldung 'ausgegeben. 'OFN_PATHMUSTEXIST muß ebenfalls gesetzt werden. Private Const OFN_HIDEREADONLY = &H4& 'Versteckt das Kontrollkästchen "Nur lesen". Private Const OFN_LONGNAMES = &H200000 'Aktiviert die Unterstützung von langen Dateinamen in den 'alten Win-3.x-Dialogen. Private Const OFN_NOCHANGEDIR = &H8& 'Stellt das ursprüngliche Verzeichnis bei Ende des Dialoges 'wieder her, wenn der Anwender anderes Verzeichnis 'eingestellt hat. Private Const OFN_NODEREFERENCELINKS = &H100000 'Weist das Dialogfeld an, bei einer markierten Verknüpfung 'Namen und Pfad der Verknüpungsdatei zurückzugeben, anstatt 'Namen und Pfad der Datei, auf die die Verknüpfung verweist. Private Const OFN_NOLONGNAMES = &H40000 'Deaktiviert die Unterstützung von langen Dateinamen in den 'alten Win-3.x-Dialogen. Private Const OFN_NONETWORKBUTTON = &H20000 'Versteckt die Schaltfläche "Netzwerk". Private Const OFN_NOTESTFILECREATE = &H10000 'Gibt an, dass keine Testdatei erzeugt wird, bevor der 'Dialog endet. In diesem Fall überprüft das Dialogfeld nicht 'auf Schreibschutz, Platzmangel auf dem Datenträger oder 'korrekten Netzwerkzugriff. Private Const OFN_OVERWRITEPROMPT = &H2& 'Gibt im Dialog "Speichern" eine Warnmeldung aus, wenn die 'Datei bereits existiert und durch das Speichern 'überschrieben wird. Private Const OFN_PATHMUSTEXIST = &H800 'Gibt an, dass der Anwender nur die Namen von existierenden 'Verzeichnissen eingeben kann. Andernfalls wird eine 'Warnmeldung ausgegeben. Private Const OFN_READONLY = &H1 'Gibt an, das das Kontrollkästchen "Nur Lesen" angekreuzt 'ist, wenn der Dialog angezeigt wird. Private Const OFN_SHAREAWARE = &H4000 'Gibt an, dass die Funktion fehlschlägt, wenn ein 'Netzwerkfehler auftritt. Private Const OFN_SHAREFALLTHROUGH = 2 Private Const OFN_SHAREWARN = 0 Private Const OFN_SHARENOWARN = 1 Private Const OFN_SHOWHELP = &H10 'Zeigt im Dialogfeld den Hilfe-Schalter an. hwndOwner muß auf 'ein Fenster zeigen, das die Hilfe anzeigen kann. Explorer- 'Dialoge senden die Nachricht CDN_HELP an die Rückruffunktion. Public Function GetSaveName(ByVal Filter$, ByVal DefExt$, _ ByVal InitialDir$, ByVal DialogTitle As String, ByVal InitFilename As String) As String Dim OFN As OpenFilename Dim Temp$ Dim n As Integer 'Bestimmen der Optionen für den Dialog With OFN 'Größe der Struktur festlegen .lStructSize = LenB(OFN) 'Das aktive Fenster (AutoCAD) wird zum Besitzer des Dialogs .hwndOwner = GetActiveWindow() 'Der Filtzer wird vorbereitet .lpstrFilter = Replace(Filter$, "|", vbNullChar) 'Speicher reservieren für kompletten Pfad .lpstrFile = InitFilename & String$(700 - LenB(InitFilename), vbNullChar) 'Größe des reservierten Speichers angeben .nMaxFile = 700 'Speicher reservieren für Dateinamen .lpstrFileTitle = String$(MAX_PATH, vbNullChar) 'Größe des reservierten Speichers angeben .nMaxFileTitle = MAX_PATH 'Das Vorgabeverzeichnis bestimmen .lpstrInitialDir = InitialDir$ & vbNullChar 'Der Titel des Dialoges .lpstrTitle = DialogTitle & vbNullChar 'Optionen bestimmen .flags = OFN_EXTENSIONDIFFERENT Or _ OFN_NOCHANGEDIR Or OFN_OVERWRITEPROMPT _ Or OFN_HIDEREADONLY 'Standarderweiterung für die Dateien bestimmen .lpstrDefExt = DefExt$ End With If GetSaveFileName(OFN) Then Temp$ = OFN.lpstrFile 'Alles nach dem NULL-Zeichen verwerfen n = InStr(Temp$, vbNullChar) If n > 1 Then GetSaveName = Left$(Temp$, n - 1) Else GetSaveName = "" End If Else GetSaveName = "" End If End Function Public Function GetOpenName(ByVal Filter As String, ByVal DefExt$, _ ByVal InitialDir$, ByVal DialogTitle As String, ByVal InitFilename As String) As String Dim OFN As OpenFilename Dim Temp$ Dim n As Integer 'Bestimmen der Optionen für den Dialog With OFN 'Größe der Struktur festlegen .lStructSize = LenB(OFN) 'Das aktive Fenster (AutoCAD) wird zum Besitzer des Dialogs .hwndOwner = GetActiveWindow() 'Der Filtzer wird vorbereitet .lpstrFilter = Replace(Filter$, "|", vbNullChar) 'Speicher reservieren für kompletten Pfad .lpstrFile = InitFilename & String$(700 - LenB(InitFilename), vbNullChar) 'Größe des reservierten Speichers angeben .nMaxFile = 700 'Speicher reservieren für Dateinamen .lpstrFileTitle = String$(MAX_PATH, vbNullChar) 'Größe des reservierten Speichers angeben .nMaxFileTitle = MAX_PATH 'Das Vorgabeverzeichnis bestimmen .lpstrInitialDir = InitialDir$ & vbNullChar 'Der Titel des Dialoges .lpstrTitle = DialogTitle & vbNullChar 'Optionen bestimmen .flags = OFN_EXTENSIONDIFFERENT Or _ OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST 'Standarderweiterung für die Dateien bestimmen .lpstrDefExt = DefExt$ End With If GetOpenFileName(OFN) Then Temp$ = OFN.lpstrFile 'Alles nach dem NULL-Zeichen verwerfen n = InStr(Temp$, vbNullChar) If n > 1 Then GetOpenName = Left$(Temp$, n - 1) Else GetOpenName = "" End If Else GetOpenName = "" End If End Function da hätte ich nach dem Portieren auf die 64bit-Version doch mal einen Probelauf machen sollen und nicht denken sollen, dass ohne Fehlermeldung alles passt... grad hab ich's ausprobiert: Der Dialog öffnet sich. ------------------
http://www.stupidedia.org/stupi/Rechter_Winkel Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
sarotti Mitglied Bauingenieur
Beiträge: 74 Registriert: 14.07.2005 AutoCad 2022 64Bit Windows 10-64Bit mit 32 GByte
|
erstellt am: 30. Mai. 2014 10:31 <-- editieren / zitieren --> Unities abgeben:
Hallo Soldnerkugel, ja jetzt läuft es unter 64-Bit. Beide Dialoge öffnen sich und man erhält als Antwort den Pfad mit Dateiname und Endung. Damit kann man weiterarbeiten. Tolle Arbeit!!!! Eine Nebensache hab ich noch festgestellt. Die Variable InitialDir$ zur Laufwerksvorauswahl wird richtig übergeben, es wird aber immer das Laufwerk ausgewählt auf das man zu letzt zugegriffen hat! Gruß Sarotti Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
ivocad Mitglied Technisches Büro für Innenarchitektur
Beiträge: 3 Registriert: 09.10.2014
|
erstellt am: 24. Aug. 2017 11:50 <-- editieren / zitieren --> Unities abgeben: Nur für sarotti
Hallo, danke auch für den Code von Soldnerkugel, verwende ihn in VBA von BricsCAD V2017 unter Win10. Aufruf: Dat1 = GetOpenName("*.dwg", "dwg", "D:\DCAD\BLOCK\", "Zeichnung für neuen Block wählen", "") Das Dialogfenster zur Dateiauswahl wird geöffnet, nur wird der Filter nicht angewendet, es sind immer alle Dateiene (*.*) auswählbar. Woran kann das liegen? Danke Ivo
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
| IT Process Manager (w/m/d) Order Entry | Unser Mandant ist ein wirtschaftlich erfolgreicher, marktführender Hersteller für Küchenmöbel. Mit circa 4.000 Mitarbeitenden erzielt unser Mandant ein Umsatzvolumen von über 1,6 Mrd. ? und beliefert Kunden in über 90 Ländern auf allen Kontinenten. Mithilfe einer vorausschauenden, konsequent umgesetzten Strategie und innovativen, digitalen Produktionsprozessen entwickelt sich das Unternehmen kontinuierlich weiter und baut seine führende Marktposition in Europa aus.... | Anzeige ansehen | Feste Anstellung |
|
KlaK Ehrenmitglied V.I.P. h.c. Dipl. Ing. Vermessung, CAD- und Netz-Admin
Beiträge: 2624 Registriert: 02.05.2006 AutoCAD LandDesktop R2 bis 2004 Civil 3D 2005 - 2022 Plateia, Canalis Visual Basic
|
erstellt am: 26. Aug. 2017 15:59 <-- editieren / zitieren --> Unities abgeben: Nur für sarotti
Hallo Ivo, ohne direkt zu testen, ändere doch mal bei der Funktionsdeklaration folgendes:
Code:
Original: Public Function GetOpenName(ByVal Filter As String, ByVal DefExt$, _ ByVal InitialDir$, ByVal DialogTitle As String, ByVal InitFilename As String) As StringNeu: Public Function GetOpenName(ByVal Filter$ As String, ByVal DefExt$, _ ByVal InitialDir$, ByVal DialogTitle As String, ByVal InitFilename As String) As String
Dein übergebener Wert wird ansonsten nicht ausgewertet ... HTH Grüße Klaus Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
| Anzeige.:
Anzeige: (Infos zum Werbeplatz >>)
|