Gewählte Dateien einfügen (Autodesk/Lisp)

Das gib es, hab ich mir 2003 mal zum Umbennen von Dateien
geschrieben du müßtes dir nur die Funktion zum einfügen noch anhängen
und das Programm auf deine Bedürfnisse anpassen.
Gruß
Niggemann
; die ersten ca. 500 zeilen stammen aus dem Internet von einem unbekannten Autor
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; STEUERUNG DER DATEIEN-AUSWAHL-DIALOGBOX ;
;;;----------------------------------------------------------------------------;
;;; Funktion: EARX:AUX:FILE-DIALOG ;
;;; ;
;;; Beschreibung: ;
;;; ;
;;; 1. Argument: FMUSTER = Dateiendung der auszuwählenden Dateien ;
;;; ;
;;; 2. Argument: TITEL = Inhalt der Titelzeile ;
;;; ;
;;; 3. Argument: MOTTO = Inhalt der obersten Dialogzeile ;
;;; ;
;;; ;
;;; Rückgabewert: Eine Liste mit den Namen inkl. Pfad, der ausgewählten ;
;;; Dateien ;
;;; ;
;;; Aufruf: (EARX:AUX:FILE-DIALOG "*.DWG" "Beispiel" "Dateien wählen");
;;;----------------------------------------------------------------------------;
(vl-load-com); damit die Fehlermeldungen auch Akustisch dargestellt werden

(defun EARX:AUX:FILE-DIALOG
(
;;;Deklaration von Aufruf-Parametern
; FMUSTER ;Dateiendung der auszuwählenden Dateien
; TITEL ;Inhalt der Titelzeile
; MOTTO ;Inhalt der obersten Dialogzeile
/
;;;Deklaration von lokalen Funktionen
EARX:ADD ;
EARX:ALLSEL ;
EARX:ALLSEL_LIS ; Entfernen aller einträge aus der Liste "LIS"
EARX:CHKOPT ;
EARX IRCHK ;
EARX RVCHK ;
EARX RIVE-LETTERS ;
EARX:FILCHK ;
EARX:GETDIRS ;
EARX:GETDRVS ;Liste der vorhandenen Laufwerke erzeugen
EARX:GETFILS ;
EARX:LISTDIRS ;
EARX:LISTDRVS ;
EARX:LISTFILS ;
EARX:LISTSEL ;
EARX:LISTWORK ;
EARX:LISTCHK ;
EARX:MPREV ;
EARX:REM ;
EARX:UNSEL ;
;;;Deklaration von lokalen Variablen
DIRLIST ;
DIRTXT ;
EARX_ALL ;
EARX_DAT ;
EARX_CURDIR ;
EARX_CURDRV ;
EARX_REM ;
EARX_SLL ;
; FILE_LIST ;wird unten nil gesetzt
FILTXT ;
LAUFWERKSLISTE ;
LAUFWERKSNAME ;
PREVLIST ;
SELTXT ;
VERZEICHNISNAME ;
)
;;; Die Übergabe Variablen erstellen
(setq MOTTO "Dateien zum Umbennen wählen" ;Meldung für Dialogbox
LOG_VAL "1" ;Vorbelegung für Logdatei schreiben, hier immer aktiv
MIN_VAL "1" ;Vorbelegung für Minimieren bei Programmausführung, hier immer aktiv
; FMUSTER (strcat "*." SUCH_ERW)
TITEL "Dialogbox für Mehrfachdateiauswahl"
;WORK_LIST (EARX:AUX:FILE-DIALOG "*.DWG" "Dialogbox für Mehrfachdateiauswahl" MOTTO)
; WORK_LIST (EARX:AUX:FILE-DIALOG (strcat "*." SUCH_ERW) "Dialogbox für Mehrfachdateiauswahl" MOTTO)
);setq
;;;----------------------------------------------------------------------------;
;;;D E F I N I T I O N D E R L O K A L E N U N T E R F U N K T I O N E N ;
;;;----------------------------------------------------------------------------;

;;; Ermitteln der Laufwerksbuchstaben ;
;;; Funktion: EARX RIVE-LETTERS ;
;;; Beschreibung: Ermittlung der verfügbaren Laufwerke als Buchstabenliste ;
(defun EARX RIVE-LETTERS (/
FSOBJ ;Das Scripting.FileSystemObject
DRIVE ;Laufwerks-Variable für Schleifenbearbeitung
DRIVES ;Die für FSOBJ zugänglichen Laufwerke
)
;;Erstellen der Laufwerksliste
(setq LAUFWERKSLISTE nil
FSOBJ (vlax-create-object "Scripting.FileSystemObject")
) ;_ Ende von setq
(vlax-for DRIVE (setq DRIVES (vlax-get-property FSOBJ 'Drives))
(setq LAUFWERKSLISTE (cons (vlax-get-property DRIVE 'DriveLetter) LAUFWERKSLISTE))
) ;_ Ende von vlax-for
(vlax-release-object DRIVES)
(vlax-release-object FSOBJ)
(setq LAUFWERKSLISTE (reverse LAUFWERKSLISTE))
) ;_ Ende von defun

;;; LISTE DER VORHANDENEN LAUFWERKE ERZEUGEN ;
;;; Funktion: EARX:GETDRVS ;
(defun EARX:GETDRVS (/ DRIVE_LISTE )
(setq LAUFWERKSLISTE nil)
(if (null (setq DRIVE_LISTE (EARX RIVE-LETTERS)))
(setq LAUFWERKSLISTE
'("C:" "D:" "E:" "F:" "G:"
"H:" "I:" "J:" "K:" "L:"
"M:" "N:" "O:" "P:" "Q:"
"R:" "S:" "T:" "U:" "V:"
"W:" "X:" "Y:" "Z:"
)
) ;_ Ende von setq
(progn
(setq LAUFWERKSLISTE '())
(foreach BUCHSTABE DRIVE_LISTE
(setq LAUFWERKSLISTE (cons (strcat BUCHSTABE ":" ) LAUFWERKSLISTE))
)
(setq LAUFWERKSLISTE (reverse LAUFWERKSLISTE))
)
) ;_ Ende von
) ;_ Ende von defun

;;; INITIALISIERUNG LAUFWERKSLISTE IN POPUP_LIST "DRV" ;
;;; Funktion: EARX:LISTDRVS ;
;;; Argumente: CURDRV = Ein String im Format: ;
;;; "Einzelner Laufwerksbuchstabe" + ":" ;
;;; ;
(defun EARX:LISTDRVS (CURDRV)
(EARX:GETDRVS)
(setq LAUFWERKSLISTE (cons CURDRV (vl-remove CURDRV LAUFWERKSLISTE)))
(start_list "DRV")
(mapcar 'add_list LAUFWERKSLISTE)
(end_list)
) ;_ Ende von defun

;;; POPUP_LIST "DRV" AUSWERTEN UND NEUE VERZEICHNISSE UND DATEIEN ANZEIGEN ;
;;; Funktion: EARX RVCHK ;
;;; ;
;;; Beschreibung: Sucht anhand der Zeigernummer den betreffenden Eintrag ;
;;; aus der statischen Variablen LAUFWERKSLISTE ;
(defun EARX RVCHK ($VALUE)
(setq LAUFWERKSNAME (strcat (nth (atoi $VALUE) LAUFWERKSLISTE) (chr 92))
PREVLIST (list LAUFWERKSNAME)
) ;_ Ende von setq
(setq VERZEICHNISNAME LAUFWERKSNAME)
(EARX:LISTDRVS (nth (atoi $VALUE) LAUFWERKSLISTE)) ;Laufwerke
(EARX:LISTDIRS VERZEICHNISNAME) ;Verzeichnisse
(EARX:LISTFILS VERZEICHNISNAME) ;Dateien
) ;_ Ende von defun

;;; ZU PROGRAMMBEGINN P R E V L I S T AUS E A R X _ C U R D I R GENERIEREN ;
;;; Funktion: EARX:MPREV ;
;;; Argumente: DRVNAME = Ein String im Format "LW:\DIR\SUB" ;
(defun EARX:MPREV (DRVNAME / NODRV NEXTPREV NEXTCHR)
(setq LAUFWERKSNAME (substr DRVNAME 1 3)
NODRV (substr DRVNAME 4)
) ;_ Ende von setq
(setq PREVLIST (cons LAUFWERKSNAME PREVLIST))
(setq NEXTPREV LAUFWERKSNAME)
(if NODRV
(progn
(repeat (strlen NODRV)
(if
(and
(/= (ascii (setq NEXTCHR (substr NODRV 1 1))) 92)
(/= (ascii (setq NEXTCHR (substr NODRV 1 1))) 47)
) ;_ Ende von and
(setq NEXTPREV (strcat NEXTPREV NEXTCHR)
NODRV (substr NODRV 2)
) ;_ Ende von setq
(progn
(setq NEXTPREV (strcat NEXTPREV (chr 92))
NODRV (substr NODRV 2)
) ;_ Ende von setq
(setq PREVLIST (cons NEXTPREV PREVLIST))
) ;_ Ende von progn
) ;_ Ende von if
) ;_ Ende von repeat
) ;_ Ende von progn
) ;_ Ende von if
) ;_ Ende von defun

;;; LISTE DER UNTERVERZEICHNISSE DES VERZEICHNISSES DNAME ;
;;; Funktion: EARX:GETDIRS ;
;;; Beschreibung: Kein Dateimuster, nur Verzeichnisse ;
;;; Argumente: DNAME = Ein String im Format "LW:\DIR\SUB" ;
(defun EARX:GETDIRS (DNAME / NLIST)
(setq DIRLIST (vl-directory-files DNAME nil -1));-1 = nur Verzeichnisse
(foreach ITEM DIRLIST
(setq NLIST (cons (strcase ITEM T) NLIST))
)
(setq NLIST (vl-remove "." NLIST))
(setq NLIST (vl-remove ".." NLIST))
(setq DIRLIST (cons ".." (vl-sort NLIST '< )))
(if (= (setq DIRTXT (strcat (itoa (length NLIST)) " Verzeichnisse")) "1 Verzeichnisse")
(setq DIRTXT "1 Verzeichniss")
)
(set_tile "DIRTXT" DIRTXT)
) ;_ Ende von defun

;;; LISTE DER UNTERVERZEICHNISSE IN LIST_BOX "DIR" ;
;;; Funktion: EARX:LISTDIRS ;
;;; Argumente: DNAME = Ein String im Format "LW:\DIR\SUB" ;
(defun EARX:LISTDIRS (DNAME) ;Ein String im Format "LW:\DIR\SUB"
(EARX:GETDIRS DNAME)
(start_list "DIR")
(mapcar 'add_list DIRLIST)
(end_list)
(set_tile "CUR" DNAME)
) ;_ Ende von defun

;;; LIST_BOX "DIR" AUSWERTEN UND NEUE DATEIEN ANZEIGEN ;
;;; Funktion: EARX IRCHK ;
(defun EARX IRCHK ($VALUE / VNAME) ; $VALUE ;ohne gehts!!!
(setq VNAME (nth (atoi $VALUE) DIRLIST))
(if (= VNAME "..")
;;;Option: Zurück zum Hauptverzeichnis
(if (= (length PREVLIST) 1)
;;;Kein Zurück weil Root
(progn
(setq VERZEICHNISNAME LAUFWERKSNAME)
) ;_ Ende von progn
;;;Zurück ausführen
(progn
(setq VERZEICHNISNAME (cadr PREVLIST))
(setq PREVLIST (cdr PREVLIST))
) ;_ Ende von progn
) ;_ Ende von if
;;;Option: Weiter zum Unterverzeichnis
(progn
(setq VERZEICHNISNAME (strcat (car PREVLIST) VNAME (chr 92)))
(setq PREVLIST (cons VERZEICHNISNAME PREVLIST))
) ;_ Ende von progn
) ;_ Ende von if
(EARX:LISTDIRS VERZEICHNISNAME) ;Verzeichnisliste auffrischen
(EARX:LISTFILS VERZEICHNISNAME) ;Dateienliste auffrischen
) ;_ Ende von defun

;;; DATEIEN DES VERZEICHNISSES FNAME ;
;;; Funktion: EARX:GETFILS ;
;;; Argumente: FNAME = Ein String im Format "LW:\DIR\SUB" ;
(defun EARX:GETFILS (FNAME / X)
(setq EARX_ALL (vl-directory-files FNAME FMUSTER 1));! 1 = Files only!
;;;Durch verwendung von FMUSTER auch andere Dateiformate möglich!
(setq
EARX_ALL
(vl-sort
(vl-remove-if-not
;;;strcase um groß-klein Unterscheidung von WINDOWS NT4 abzufangen!
'(lambda (X) (wcmatch (strcase X) FMUSTER))
EARX_ALL
) ;_ Ende von REMOVE-IF-NOT
'<
) ;_ Ende von SORT
) ;_ Ende von setq
(if (>= (length EARX_ALL) 1)
(mode_tile "S_A" 0)
(mode_tile "S_A" 1) ;Ausgrauen wenn keine Dateien
) ;_ Ende von if
(if (= (setq FILTXT (strcat (itoa (length EARX_ALL)) " Dateien")) "1 Dateien")
(setq FILTXT "1 Datei")
)
(set_tile "FILTXT" FILTXT)
) ;_ Ende von defun

;;;DATEILISTE IN LIST_BOX "FIL" MIT ABFANG FÜR "KEINE DATEIEN" ;
;;; Funktion: EARX:LISTFILS ;
;;; Argumente: FNAME = Ein String im Format "LW:\DIR\SUB" ;
(defun EARX:LISTFILS (FNAME)
(EARX:GETFILS FNAME)
(if (/= EARX_ALL '(""))
(progn
(start_list "FIL")
(mapcar 'add_list EARX_ALL)
(end_list)
) ;_ Ende von progn
(progn
(start_list "FIL")
(add_list '(""))
(end_list)
) ;_ Ende von progn
) ;_ Ende von if
) ;_ Ende von defun

;;; LIST_BOX "FIL" AUSWERTEN ;
;;; Funktion: EARX:FILCHK ;
(defun EARX:FILCHK (EARX_FILE_LIST)
(EARX:LISTSEL EARX_FILE_LIST)
(if (= (length EARX_SLL) (length EARX_ALL))
(mode_tile "S_A" 1)
(mode_tile "S_A" 0)
) ;_ Ende von if
(if (= (length EARX_ALL) 0)
(mode_tile "S_A" 1)
) ;_ Ende von if
(if (/= (get_tile "FIL") "")
(progn
(mode_tile "ADD" 0)(mode_tile "C_A" 0)
) ;_ Ende von progn
(progn
(mode_tile "ADD" 1)(mode_tile "C_A" 1)
) ;_ Ende von progn
) ;_ Ende von if
) ;_ Ende von defun

;;; MEHRFACHWAHL IN LIST_BOX "FIL" AUSWERTEN UND AUFZÄHLUNG IN LISTE VERWANDELN;
;;; Funktion: EARX:LISTSEL ;
(defun EARX:LISTSEL (EARX_FILE_LIST / EARX_ITEM EARX_INDEX)
;;;Holt String mit Aufzählung der Nummern der gewählten Einträge
(setq EARX_SLL (list))
;;;Leerzeichen hinter Aufzählung setzen
(setq EARX_INDEX 1
EARX_ITEM ""
EARX_FILE_LIST (strcat EARX_FILE_LIST " ")
) ;_ Ende von setq
;;;Solange Ende der Aufzählung noch nicht erreicht
(while (/= EARX_INDEX (1+ (strlen EARX_FILE_LIST)))
(if (/= (substr EARX_FILE_LIST EARX_INDEX 1) " ")
;;;Wenn nicht " " - an vorheriges Zeichen anhängen - Ermöglicht mehrstellige Zähler
(setq EARX_ITEM (strcat EARX_ITEM (substr EARX_FILE_LIST EARX_INDEX 1)))
;;;Wenn " " -> Zahl abgeschlossen - betreffendes Element anhand der Nummer aus
;;;EARX_ALL holen und in EARX_SLL vorne anfügen
(progn
(setq EARX_SLL (cons (nth (atoi EARX_ITEM) EARX_ALL) EARX_SLL)
EARX_ITEM ""
)
) ;_ Ende von progn
) ;_ Ende von if
(setq EARX_INDEX (1+ EARX_INDEX))
) ;_ Ende von while
(setq EARX_SLL (vl-sort EARX_SLL '< ))
(setq FILTXT
(strcat (itoa (length EARX_SLL))
" von "
(itoa (length EARX_ALL))
" Dateien gewählt"
)
)
(set_tile "FILTXT" FILTXT)
) ;_ Ende von defun

;;; ALLE DATEIEN AUSWÄHLEN ;
;;; Funktion: EARX:ALLSEL ;
(defun EARX:ALLSEL (/ EARX_INDEX EARX_INDEX_STR )
(setq EARX_INDEX 0 EARX_INDEX_STR "")
(repeat (length EARX_ALL)
(set_tile "FIL" (itoa EARX_INDEX))
(setq EARX_INDEX_STR (strcat EARX_INDEX_STR (itoa EARX_INDEX) " ")
EARX_INDEX (1+ EARX_INDEX)
) ;_ Ende von setq
) ;_ Ende von repeat
(mode_tile "S_A" 1)
(mode_tile "C_A" 0)
(mode_tile "ADD" 0)
(EARX:LISTSEL EARX_INDEX_STR)
) ;_ Ende von defun

;;; ALLE DATEIEN ABWÄHLEN ;
;;; Funktion: EARX:UNSEL ;
(defun EARX:UNSEL ()
(set_tile "FIL" "")
(mode_tile "C_A" 1)
(mode_tile "S_A" 0)
(mode_tile "ADD" 1)
(setq EARX_SLL '())
(if (= (setq FILTXT (strcat (itoa (length EARX_ALL)) " Dateien")) "1 Dateien")
(setq FILTXT "1 Datei")
)
(set_tile "FILTXT" FILTXT)
) ;_ Ende von defun

;;; ALLE DATEIEN aus der Arbeitsliste AUSWÄHLEN ;
;;; Funktion: EARX:ALLSELLIS ;
(defun EARX:ALLSEL_LIS (/ REM_LIST )
(setq REM_LIST FILE_LIST)
(if (> (length REM_LIST) 0)
(progn
(foreach X REM_LIST
(setq FILE_LIST (vl-remove X FILE_LIST))
) ;_ Ende von foreach
(setq EARX_REM '())
(EARX:LISTWORK)
(mode_tile "REM" 1)
);Ende von progn
);Ende von if
); Ende von defun

;;; DATEIENLISTE IN LIST_BOX "LIS", DIE ARBEITSLISTE ;
;;; Funktion: EARX:LISTWORK ;
(defun EARX:LISTWORK ()
(start_list "LIS")
(mapcar 'add_list FILE_LIST)
(end_list)
(if (> (length FILE_LIST) 0)
(mode_tile "accept" 0);accept
(mode_tile "accept" 1);accept
) ;_ Ende von if
(if (= (setq SELTXT (strcat (itoa (length FILE_LIST)) " Dateien")) "1 Dateien")
(setq SELTXT "1 Datei")
)
(set_tile "SELTXT" SELTXT)
) ;_ Ende von defun

;;; GEWÄHLTE DATEIEN ZU FILE_LIST HINZUFÜGEN ;
;;; Funktion: EARX:ADD ;
;;; Beschreibung: Filtern von Doppeleinträgen durch vl-sort ;
(defun EARX:ADD (/ PREVWORK NEW_ITEM )
(if (> (length EARX_SLL) 0)
(progn
(foreach X EARX_SLL
(if (not (member (setq NEW_ITEM (strcat (strcase VERZEICHNISNAME) (strcase X))) FILE_LIST))
(setq FILE_LIST (cons NEW_ITEM FILE_LIST))
)
) ;_ Ende von foreach
(setq FILE_LIST (vl-sort FILE_LIST '< ))
(EARX:LISTWORK)
(mode_tile "ALL_REM" 0)
(if (/= FILE_LIST (car PREVWORK))(setq PREVWORK (cons FILE_LIST PREVWORK))) ;_ Ende von if
;;Da die gewählten Dateien nun in der Arbeitsliste sind, wird die Auswahl zurück gesetzt
(EARX:UNSEL)
) ;_ Ende von progn
) ;_ Ende von if
) ;_ Ende von defun

;;; GEWÄHLTE DATEIEN AUS FILE_LIST ENTFERNEN ;
;;; Funktion: EARX:REM ;
(defun EARX:REM ()
(if (> (length EARX_REM) 0)
(progn
(foreach X EARX_REM
(setq FILE_LIST (vl-remove X FILE_LIST))
) ;_ Ende von foreach
(setq EARX_REM '())
(EARX:LISTWORK)
(mode_tile "REM" 1)
; (mode_tile "ALL_REM" 1)
) ;_ Ende von progn
) ;_ Ende von if
) ;_ Ende von defun

;;; MEHRFACHWAHL IN LIST_BOX "LIS" AUSWERTEN UND AUFZÄHLUNG IN LISTE VERWANDELN;
;;; Funktion: EARX:LISTCHK ;
(defun EARX:LISTCHK (FILE_TEXT / EARX_ITEM EARX_INDEX )
(setq Test_a File_text)
;;;Holt String mit Aufzählung der Nummern der gewählten Einträge
(setq EARX_REM '()
;;;Leerzeichen hinter Aufzählung setzen
EARX_INDEX 1
EARX_ITEM ""
FILE_TEXT (strcat FILE_TEXT " ")
) ;_ Ende von setq
;;;Solange das Ende der Aufzählung noch nicht erreicht
(while (/= EARX_INDEX (1+ (strlen FILE_TEXT)))
(if (/= (substr FILE_TEXT EARX_INDEX 1) " ")
;;;Wenn nicht " " - an vorheriges Zeichen anhängen - Ermöglicht mehrstelligen Zähler
(setq EARX_ITEM
(strcat EARX_ITEM (substr FILE_TEXT EARX_INDEX 1))
) ;_ Ende von setq
;;;Wenn " " -> Zahl abgeschlossen - betreffendes Element anhand der Nummer aus
;;;FILE_LIST holen und in EARX_REM vorne anfügen
(progn
(setq
EARX_REM (cons (nth (atoi EARX_ITEM) FILE_LIST) EARX_REM)
) ;_ Ende von setq
(setq EARX_ITEM "")
) ;_ Ende von progn
) ;_ Ende von if
(setq EARX_INDEX (1+ EARX_INDEX))
) ;_ Ende von while
(if (/= (get_tile "LIS") "")
(progn (mode_tile "REM" 0) (mode_tile "ALL_REM" 0))
(progn (mode_tile "REM" 1)); (mode_tile "ALL_REM" 1))
) ;_ Ende von if
(setq SELTXT (strcat (itoa (length EARX_REM)) " von " (itoa (length FILE_LIST)) " Dateien zum Entfernen gewählt"))
(set_tile "SELTXT" SELTXT)
) ;_ Ende von defun

;;; OPTION LOGDATEI SCHREIBEN UND MINIMIEREN AUSWERTEN ;
;;; Funktion: EARX:CHKOPT ;
(defun EARX:CHKOPT ()
(if (= (get_tile "log") "1")(setq LOG_VAL "1")(setq LOG_VAL "0"))
(if (= (get_tile "min") "1")(setq MIN_VAL "1")(setq MIN_VAL "0"))
(setq NACH_DATUM (get_tile "NACH_DATUM"))
(setq ERWEITERUNG (get_tile "ERWEITERUNG"))
)
(defun SUCHERW ()
(setq ERW_LIST '("JPG" "DWG" "BAK" "PDF" "*" ))
(start_list "SUCH_ERWEITERUNG")
(mapcar 'add_list ERW_LIST)
(end_list)
);ende defun SUCHERW
(defun CHECK_STARTWERT (WAS)
; (if (= (vl-string-trim " " WAS) "")(progn (setq WAS "1")(set_tile "STARTWERT" WAS)))
(if (wcmatch WAS "*@*,*.*,*[]`#`@`?`*`~`[Ž``'!%^&()+={}|`\\:;\"<>/]*");"*@*,*.*") ; wenn etwas ausser Zahlen Punkt und Komma
(progn ; dannausdruck
(set_tile "error" "Nur Nummeriche Werte größer \" 0 \" sind im Startwert erlaubt")
(mode_tile "STARTWERT" 2)(mode_tile "STARTWERT" 3)
(vlr-beep-reaction)
nil
) ;ende progn
(progn ; sonstausdruck
(set_tile "error" "")
(setq STARTWERT (vl-string-trim " " WAS))
T
) ; ende progn
); ende if
); ende defun CHECK_STARTWERT
;; Das Suchmuster in Großbuchstaben umwandeln
(defun SET_FMUSTER (WAS)
(setq FMUSTER (strcat (strcase WAS) "."(nth (atoi (get_tile "SUCH_ERWEITERUNG")) ERW_LIST)))
(setq SUCH_DATEI (strcase WAS))
(set_tile "SUCH_DATEI" (strcase WAS))
);ende defun SET_FMUSTER

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Hauptfunktion FILE-DIALOG ;
;;;----------------------------------------------------------------------------;
(setq EARX_DAT (load_dialog "UMBENNEN.DCL"))
(if (not (new_dialog "FSEL" EARX_DAT))
(exit)
) ;_ Ende von if
(setq EARX_CURDIR (getvar "DWGPREFIX")
EARX_CURDRV (substr EARX_CURDIR 1 2)
VERZEICHNISNAME EARX_CURDIR
EARX_ALL '()
EARX_SLL '()
PREVLIST '()
) ;_ Ende von setq
;;Die liste mit Dateinamen erweiterung erstellen und in der Popup-Liste anzeigen
(SUCHERW)
;;Damit etwas gewählt wird den 1. Eintrag vorbestimmen.
(setq SUCH_DATEI "*")
(setq FMUSTER (strcat SUCH_DATEI "." (nth 0 ERW_LIST)))
(setq STARTWERT "1")
(set_tile "STARTWERT" "1")
(setq PRAEFIX "DSC")
(set_tile "SUCH_DATEI" SUCH_DATEI)
(set_tile "PRAEFIX" PRAEFIX)
(EARX:LISTDRVS EARX_CURDRV)
(EARX:LISTDIRS EARX_CURDIR)
(EARX:LISTFILS EARX_CURDIR)
(EARX:MPREV EARX_CURDIR)
(set_tile "TITEL" TITEL)
(set_tile "MOTTO" MOTTO)
(mode_tile "ADD" 1)
(mode_tile "accept" 1);accept
(mode_tile "C_A" 1)
(mode_tile "REM" 1)
(mode_tile "ALL_REM" 1)
(set_tile "log" LOG_VAL)
(set_tile "min" MIN_VAL)
(if ERWEITERUNG (set_tile "ERWEITERUNG" ERWEITERUNG)(set_tile "ERWEITERUNG" ""))
(set_tile "NACH_DATUM" "1")
(action_tile "SUCH_DATEI" "(SET_FMUSTER $value)")

(action_tile "SUCH_ERWEITERUNG" "(setq FMUSTER (strcat SUCH_DATEI \".\" (nth (atoi $value) ERW_LIST)))")
(action_tile "DRV" "(EARX RVCHK $VALUE)")
(action_tile "DIR" "(EARX IRCHK $VALUE)")
(action_tile "FIL" "(EARX:FILCHK $VALUE)")

(action_tile "ADD" "(EARX:ADD)")
(action_tile "S_A" "(EARX:ALLSEL)")
(action_tile "C_A" "(EARX:UNSEL)")

(action_tile "LIS" "(EARX:LISTCHK $VALUE)")
(action_tile "REM" "(EARX:REM)")
(action_tile "ALL_REM" "(EARX:ALLSEL_LIS)")
(action_tile "log" "(setq LOG_VAL $value)")
(action_tile "min" "(setq MIN_VAL $value)")
; (action_tile "NACH_DATUM"); wird hier nicht bearbeitet
(action_tile "PRAEFIX" "(setq PRAEFIX $value)")
(action_tile "ERWEITERUNG" "(setq ERWEITERUNG $value)")
(action_tile "STARTWERT" "(CHECK_STARTWERT $value)") ;(setq STARTWERT $value)
;; (action_tile "UMBENNEN" "(EARX:CHKOPT)(setq OPTION \"L\")")
(action_tile "accept" "(EARX:CHKOPT)(setq OPTION \"L\")(done_dialog 1)")
(action_tile "cancel" "(setq EARX_SLL '() FILE_LIST '()) (done_dialog 0)")
; Hilfe bestimmen
(action_tile "HILFE" "(acad_helpdlg \"NIGGDATA.chm\" \"Umbennen\")")
(start_dialog)
(unload_dialog EARX_DAT)
FILE_LIST;Rückgabewert
) ;_ Ende von defun FILE-DIALOG

Und die DCL sieht so aus:
//dcl_settings : default_dcl_settings { audit_level = 3; }

FSEL
: dialog {
key = TITEL;
: column {
: text {
key = MOTTO;
width = 80;
alignment = left;
}
: row {
: text {
label = "Aktuelles Verzeichnis: ";
}
: text {
key = CUR;
}
}
}
: row {
: boxed_column {
: edit_box {
label = "Dateiname:";
key = "SUCH_DATEI";
width = 15;
}
: popup_list {
label = "Zu suchende Dateierweiterung:";
key = "SUCH_ERWEITERUNG";
width = 3;
// fixed_width = true;
// height = 6;
}

: popup_list {
label = "Laufwerk:";
key = "DRV";
width = 30;
fixed_width = true;
}
spacer ;
: column {
: column {
: list_box {
label = "Verzeichnisse";
key = "DIR";
width = 30;
fixed_width = true;
height = 6;
}
: text {
key = DIRTXT;
}
}
: column {
: list_box {
label = "Dateien";
key = "FIL";
width = 30;
fixed_width = true;
height = 8;
multiple_select = true;
}
: text {
key = FILTXT;
}
}
}
: column {
: button {
label = "Alle auswählen";
key = "S_A";
fixed_width = true;
width = 30;
alignment = centered;
mnemonic ="w";
}
: button {
label = "Alle abwählen";
key = "C_A";
fixed_width = true;
width = 30;
alignment = centered;
mnemonic ="b";
}
}
}
: boxed_column {
spacer;
: ok_button {
label = "<<Entfernen";
key = "REM";
width = 10;
fixed_width = true;
alignment = centered;
mnemonic ="E";
}
: ok_button {
label = "<<Alle Entfernen";
key = "ALL_REM";
width = 10;
fixed_width = true;
alignment = centered;
mnemonic ="A";
}
: button {
label = "Übernehmen>>";
key = "ADD";
width = 10;
fixed_width = true;
alignment = centered;
mnemonic ="n";
}
spacer_1;
}
: column {
: boxed_column {
: column {
: list_box {
label = "Arbeitsliste";
key = "LIS";
width = 60;
fixed_width = true;
height = 19;
multiple_select = true;
}
: text {
key = "SELTXT";
}
}
}
:row {
: toggle {
label = "Nach Datum sortieren";
key = "NACH_DATUM" ;
}
}
:row {
: edit_box {
label = "Präfix:";
key = "PRAEFIX";
width = 20;
fixed_width = true;
}
: edit_box {
label = "Startwert:";
key = "STARTWERT";
width = 20;
fixed_width = true;
}
: edit_box {
label = "Dateiendung:";
key = "ERWEITERUNG";
width = 3;
fixed_width = true;
}
}
: row {
// : button {
// label = "Umbennen";
// key = "UMBENNEN";
// fixed_width = true;
// width = 10;
// alignment = centered;
// mnemonic ="U";
// }
: button {
label = "OK";
key = "accept";
fixed_width = true;
width = 20;
alignment = centered;
mnemonic ="O";
}
: cancel_button {
label = "Abbruch";
key = "cancel";
fixed_width = true;
width = 20;
alignment = centered;
mnemonic ="A";
is_cancel = true;
}
: cancel_button {
label = "Hilfe";
key = "HILFE";
fixed_width = true;
width = 20;
alignment = centered;
mnemonic ="H";
is_cancel = true;
}
}
: errtile { }
}
}

}

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP