Code:
;|
Funktion schreibt eine Liste der aktuell in Map Zugeordneten DWG's in eine externe DateiArgumente:
STR-FULLPATHFILENAME = String der die KOMPLETTE Zieldateiinformation enthält
also Pfad + Dateiname + Dateierweiterung
Achtung bei Pfadangaben, es gelten hier die Lisp-Regeln
für Backslashes -> EIN Backslash muß als ZWEI Backslashes
eingegeben werden. Alternativ ist es auch möglich
EINEN Backslash als EINEN Slash anzugeben.
Beispiel:
"c:\\temp\\test.txt" oder "c:/temp/test.txt"
"\\\\SERVERNAME\\FREIGABENAME\\test.cad" oder
"//SERVERNAME/FREIGABENAME/test.cad"
Rückgabe = String der die KOMPLETTE Zieldateiinformation enthält
bei ERFOLG,
nil wenn Datei nicht angelegt wurde
Aufrufbeispiel:
(MAP:DWG-ALIAS->LST "//Server/Freigabe/$test.cad")
oder
(MAP:DWG-ALIAS->LST "c:\\test.tmp")
|;
(defun MAP:DWG-ALIAS->LST
(STR-FULLPATHFILENAME /
ALIAS INDEX LST-ALIAS
LST-DWG RETVAL
)
(if (setq LST-DWG (ade_dslist))
(progn
(setq LST-DWG (mapcar 'ade_dwgactualpath LST-DWG))
(if (setq LST-ALIAS (ade_aliasgetlist))
(setq
LST-ALIAS (vl-sort LST-ALIAS
'(lambda (X Y)
(> (strlen (cadr X)) (strlen (cadr Y)))
)
)
LST-DWG (mapcar
(function
(lambda (X)
(setq INDEX 0)
(while (< INDEX (length LST-ALIAS))
(if (vl-string-search
(cadr (nth INDEX LST-ALIAS))
X
)
(setq ALIAS (nth INDEX LST-ALIAS)
INDEX (length LST-ALIAS)
)
(setq INDEX (1+ INDEX))
)
)
(list ALIAS (vl-string-subst "" (cadr ALIAS) X))
)
)
LST-DWG
)
RETVAL (LIST>FILE 'LST-DWG STR-FULLPATHFILENAME)
)
)
)
)
RETVAL
)
;|
Funktion liest eine von der Funktion "MAP:DWG-ALIAS->LST" geschriebene Liste
der zugeordneten DWG-Files aus einer Text-Datei und stellt diese Zuordung
unter Berücksichtigung der vorher verwendeten Aliasnamen wieder her.
Argumente:
STR-FULLPATHFILENAME = String der die KOMPLETTE Zieldateiinformation enthält
also Pfad + Dateiname + Dateierweiterung
Achtung bei Pfadangaben, es gelten hier die Lisp-Regeln
für Backslashes -> EIN Backslash muß als ZWEI Backslashes
eingegeben werden. Alternativ ist es auch möglich
EINEN Backslash als EINEN Slash anzugeben.
Beispiel:
"c:\\temp\\test.txt" oder "c:/temp/test.txt"
"\\\\SERVERNAME\\FREIGABENAME\\test.cad" oder
"//SERVERNAME/FREIGABENAME/test.cad"
Rückgabe = Liste die aus dem Textfile gelesen wurde, wenn
erfolgreich gelesen werden konnte,
nil wenn nicht möglich
Aufrufbeispiel:
(MAP:DWGLST->ATTACH "//Server/Freigabe/$test.cad")
oder
(MAP:DWGLST->ATTACH "c:\\test.tmp")
|;
(defun MAP:DWGLST->ATTACH (STR-FULLPATHFILENAME
/ FOUND
LST-ALIAS LST-DWG
STR-FILENAME OLD-CMDDIA
RETVAL OLD-FILEDIA
)
(if (not
(= (setq LST-DWG (load STR-FULLPATHFILENAME "err")) "err")
)
(progn
(setq LST-ALIAS (ade_aliasgetlist))
;; prüfen der Alias ggf. Abändern der Pfade...
(foreach ELEM (DT:LIST-REMOVE-DOUBLE (mapcar 'car LST-DWG))
(if (setq FOUND (MS-ASSOC (car ELEM) LST-ALIAS))
(if (/= (cadr ELEM) (cadr FOUND))
(ade_aliasupdate (car FOUND) (cadr ELEM))
)
;; Nicht gefunden, erzeuge neu
(ade_aliasadd (car ELEM) (cadr ELEM))
)
)
(setq OLD-CMDDIA (getvar "cmddia")
OLD-FILEDIA (getvar "filedia")
)
(setvar "cmddia" 0)
(setvar "filedia" 0)
(foreach ELEM LST-DWG
(setq STR-FILENAME
(strcat (caar ELEM)
":"
(cadr ELEM)
)
)
(command "_ADEDRAWINGS" "_attach" STR-FILENAME "")
)
(setvar "cmddia" OLD-CMDDIA)
(setvar "filedia" OLD-FILEDIA)
(setq RETVAL LST-DWG)
)
)
RETVAL
)
(defun MAP:DWG->LST (STR-FULLPATHFILENAME / FILE-DESC LST-DWG RETVAL)
(if (setq LST-DWG (ade_dslist))
(progn
(setq LST-DWG (mapcar 'ade_dwgactualpath LST-DWG))
(if (setq FILE-DESC (open STR-FULLPATHFILENAME "w"))
(progn
(foreach ELEM LST-DWG
(write-line ELEM FILE-DESC)
)
(close FILE-DESC)
(setq RETVAL STR-FULLPATHFILENAME)
)
)
)
)
RETVAL
)
;|
Funktion schreibt eine oder mehrere Listen in eine Datei
Argumente:
SYMLIST = Symbol oder Liste von Symbolen
z.B. (setq sym1 '(1 2 3))
-> (LIST>FILE 'Sym1 "c:\\test.txt")
oder (setq sym1 '(1 2 3) sym2 "Haseldasel")
-> (LIST>FILE '(Sym1 sym2) "c:\\test.txt")
FILENAME = STRING für Name der Datei in die geschrieben werden soll
-> c:\\temp\\test.txt
Bitte hierbei beachten: Lisp konforme Verwendung von Pfaden
Entweder ZWEI Backslashes für jeden Backslash der Pfadangabe
(bei UNC Pfaden also z.B.: "\\\\SERVERNAME\\FREIGABENAME")
oder für jeden Backslash EIN Slash verwenden
(z.B. "//SERVERNAME/FREIGABENAME")
|;
(defun LIST>FILE (SYMLIST FILENAME / FH RETVAL)
(if (setq FH (open FILENAME "w"))
(progn
(foreach SYM (if (listp SYMLIST)
SYMLIST
(list SYMLIST)
)
(princ "(setq " FH)
(princ SYM FH)
(foreach ITEM (list (cons 'quote (list (eval SYM))))
(prin1 ITEM FH)
)
(princ ")" FH)
)
(close FH)
(setq RETVAL FILENAME)
)
)
RETVAL
)
;;; Ersatz für Assoc. Assoc ist in diesem Fall case-sensitive
;;; ms-assoc nicht. Kontrolle für doppelte Einträge fehlt hier
;;; aber assoc gibt ja auch immer nur den ersten zurück...
(defun MS-ASSOC (STR LST / RETVAL)
(if (setq
RETVAL (vl-remove-if-not
'(lambda (X) (equal (strcase (car X)) (strcase STR)))
LST
) ;_ end of vl-remove-if-not
) ;_ end of setq
(car RETVAL)
) ;_ end of if
) ;_ end of defun
(defun DT:LIST-REMOVE-DOUBLE (LISTE / RETURNLISTE)
(if (= (type LISTE) 'list)
(progn
(foreach ELEMENT LISTE
(if (not (member ELEMENT RETURNLISTE))
(setq RETURNLISTE (cons ELEMENT RETURNLISTE))
) ;_ end of if
) ;_ end of foreach
(reverse RETURNLISTE)
) ;_ end of progn
) ;_ end of if
) ;_ end of defun