LISP-Codes - Bosse-engineering Blog - LISP-Programmierung für AutoCAD und BricsCAD

Im Visual-Lisp-Editor ist den vorhandenen Standardfunktionen die Option „Schützen und zuweisen“ zugewiesen. Alle Funktionen (Symbole) mit dieser Option werden standardmäßig in der Farbe blau dargestellt.

bosse_macht_blau, der vollständige LISP-Code zu diesem Artikel

Beispiel Symbol-Service für die Standard-Funktion MAPCAR:



Jetzt wollte ich auch den selbstdefinierten Funktionen aus meiner Standardbibliothek diese Option zuweisen, damit diese ebenfalls in der Farbe blau dargestellt werden. Damit möchte ich die Lesbarkeit des Codes verbessern.

Beispiel vorher:



Beispiel nacher:



Ich könnte jetzt für jede meiner Funktionen einzeln den Symbol-Service nutzen und die Option „Schützen und zuweisen“ verwenden. Das ist aber erstens sehr mühselig, und zweitens, denke ich bestimmt nicht daran, auch den neuen Funktionen diese Option zuzuweisen, wenn ich meine Funktionsbibliothek irgendwann erweitern werde.

Auf http://www.cad.de bin ich dann im LISP-Forum fündig geworden:
http://ww3.cad.de/foren/ubb/Forum145/HTML/002663.shtml#000003

Dort sind folgende Codezeilen zu finden:

(defun codecolor ()
(setq functionlist (list 'getattrib ....'pline 'islocked?))
(eval (list 'pragma (list 'quote (list (cons 'unprotect-assign functionList)))))
(eval (list 'pragma (list 'quote (list (cons 'protect-assign funct

Es wird eine Funktionsliste definiert mit all den Funktionen, die später blau dargestellt werden sollen.

Dann werden zwei Listen evaluiert in der jeweils die Funktion PRAGMA enthalten ist. In der ersten Liste wird bei allen Funktionen aus der Funktionsliste die Option „Schützen und zuweisen“ deaktiviert, bei der zweiten Funktion aktiviert. Wie die Funktionen jetzt ganz genau arbeiten weiß ich noch nicht, aber ich weiß was ich mit den Codes anfangen kann ;-)

Mein eigentliches Problem ist jetzt aber, dass ich wieder vor scheinbarer Handarbeit stehe, denn ich muss die obere Funktionsliste zusammenstellen. Ich habe in meiner Funktionsbibliothek ca. 300 Funktion, das heißt, in die Hände spucken und los geht’s, oder, der bessere Weg, mir eine Funktion schreiben, die das für mich erledigt.

Voraussetzungen: ich habe die LISP-Biobliotheksdatei „JBfunktionen.lsp“. In dieser Datei sind ca. 300 Funktionen enthalten, die alle mit „(defun JBf“ beginnen, z.B.



Folgende Schritte sind jetzt notwendig:
Lesen der Datei „JBfunktionen.lsp“ in eine Liste (jede Zeile ein Listeneintrag):

(defun JBf_file_read (dateipfad / DATEI LISTE ZEILE)
(if(setq datei (open dateipfad "r"))
(progn
 (while (setq zeile (read-line datei))
(setq liste (cons zeile liste)))
(close datei)))liste)

In der Liste werden alle Einträge gelöscht, die nicht den String „(defun“ enthalten:

(setq liste (vl-remove-if'(lambda(A)(not(vl-string-search "(defun" ...

Jeder Listeneintrag wird jetzt anhand des Zeichens “(“ in einzelne Stringelemente geteilt und wiederum in eine Liste gespeichert:

(defun JBf_string_trennzeichen->list (str str_trenn / list_str)
(if (vl-string-search str_trenn str)
(progn
(while (vl-string-search str_trenn str)
(setq list_str (cons (substr str 1 (vl-string-search str_trenn str))list_str)
str (substr str(+(vl-string-search str_trenn str)(+ (strlen str_trenn)1)))))
(setq list_str (cons str list_str)))
(setq list_str (cons str list_str)))
(reverse list_str))

Die Zeile “(defun JBf_string_trennzeichen->list (str str_trenn / list_str)” würde z.B. folgende Liste ergeben:



Jetzt muß ich aus dem jeweils 2. Eintrag der Liste den String „defun“ und die Leerzeichen entfernen:

(defun Bosse_macht_blau:String (str / )
(while (vl-string-search " " str)
(setq str (vl-string-subst "" " " str)))
(vl-string-subst "" "defun" string))

Als Ergebnis bekomme ich dann jeweils den alleinstehenden Funktionsnamen in einer Liste. Falls in meiner Bibliotheksdatei jetzt aber noch eine Funktion vorhanden sein sollte, die nicht mit „JBf“ beginnt kann ich diese Funktionsnamen jetzt noch herausfiltern:

(vl-remove-if '(lambda(A)(/= (strcase(substr A 1 3))"JBf"...

Auf diese Liste wird noch ein (mapcar ‘read angewand, und schon habe ich die passende Liste für meine gefundene Funktion:

Aus einer Koordinatendatei sollen alle xy-Werte um den Vektor 3500000,5900000 verbessert werden.

• Original: 66351.948013 45680.018997 13.291000
  

• Verbessert: 3566351.948013 5945680.018997 13.291000
  

Als weiteres Problem kommt hinzu, daß es sich um sehr große Dateien handelt (bis zu 12 Millionen Zeilen). Zu Beginn nehme ich aber eine kleine Koordinatendatei mit 10 Zeilen, um die Funktionalitäten der grundlegenden Funktionen zu testen.

• 66351.948013 45680.018997 13.291000
  

• 66362.434006 45682.344986 13.271988
  

• 66347.912003 45623.077011 13.060013
  

• 66362.258011 45599.085007 13.082993
  

• 66362.336990 45599.043991 13.081985
  

• 66359.931992 45599.594009 13.065994
  

• 66362.173996 45599.115005 13.081009
  

• 66362.095993 45599.155991 13.081985
  

• 66363.448990 45597.930008 13.084000
  

• 66363.268997 45597.977005 13.081985
  

Mit folgender Funktion werden die Koordinaten in eine Liste eingelesen:

(defun JB_Koord:Read (dateiname / zeile datei zeilen_liste)
(if(setq datei (open dateiname "r"))
(progn
(while (setq zeile (read-line datei))
(setq zeilen_liste (cons zeile zeilen_liste)))
 (close datei)))
(reverse zeilen_liste))

Für jede Koordinatenzeile existiert jetzt ein Gesamtstring, z.B.
„66363.268997 45597.977005 13.081985“

Es müssen die einzelnen Werte mit der Funktion READ aus dem String in eine Liste gebracht werden, dazu verwende ich ein MAPCAR-Schleife.

(defun JB_Koord:String:Read (zeilen_liste / A)
(mapcar ‘(lambda(A)
(read(strcat “(” A “)”)))zeilen_liste))

Daraus ergibt sich ein Liste mit REAL-Zahlen, z.B.
(66363.268997 45597.977005 13.081985)

Auf den X-Wert soll jetzt 3500000 und auf den Y-Wert 5900000 addiert werden, wieder in einer MAPCAR-Schleife:

(defun JB_Koord:Real:Verb (liste / A)
(mapcar ‘(lambda(A)
(mapcar ‘+ A’(3500000.0 5900000.0 0.0)))liste))

Daraus ergibt sich ein Liste mit REAL-Zahlen, z.B.
(3566363.268997 5945597.977005 13.081985)

Jetzt müssen die neuen Daten wieder in die Koordinatendatei geschrieben werden:

(defun JB_Koord:Write (dateiname liste / )
(setq datei (open dateiname “w”))
(setvar “DIMZIN” 3);;;Damit nachführenden Nullen geschrieben werden
(mapcar ‘(lambda(A)
(write-line
(strcat
(rtos (car A)2 6)” “
(rtos (cadr A) 2 6)” “
(rtos (caddr A) 2 6))datei))liste)
(close datei))

Das war es schon, in einer aufrufenden Funktion zusammen geschrieben würde es folgendermaßen aussehen:

(defun c:JB_Koord ( / dateiname)
(setq dateiname “c:\temp\test.kor”)
(JB_Koord:Write dateiname
(JB_Koord:Real:Verb
(JB_Koord:String:Read
(JB_Koord:Read dateiname)))))

Als Ergebnis würde die Koordinatendatei wie folgt aussehen:

• 3566351.948013 5945680.018997 13.291000
  

• 3566362.434006 5945682.344986 13.271988
  

• 3566347.912003 5945623.077011 13.060013
  

• 3566362.258011 5945599.085007 13.082993
  

• 3566362.336990 5945599.043991 13.081985
  

• 3566359.931992 5945599.594009 13.065994
  

• 3566362.173996 5945599.115005 13.081009
  

• 3566362.095993 5945599.155991 13.081985
  

• 3566363.448990 5945597.930008 13.084000
  

• 3566363.268997 5945597.977005 13.081985
  

(Die folgenden Zeitangaben beziehen sich auf folgenden Rechner: CIntel® Core™2 Duo CPU, T7700 @ 2.40GHz, 2.39GHz, 2.00 GB RAM)

Soweit so gut, keine Probleme, was passiert jetzt aber wenn wir eine Koordinatendatei mit 12 Millionen Datenzeilen verbessern wollen? Die Funktion „JB_Koord:Read“ schafft es noch, es dauert ca. 1.5 Minuten, dann sind die Zeilenstrings in einer Liste, fertig für die Weiterverarbeitung.

Der Blick in den Taskmanager zeigt, die Auslagerungsdatei hat um ca. 1GB zugenommen, bei modernen Rechnern aber noch kein Problem.

Sobald aber die Funktion „JB_Koord:String:Read“ aufgerufen wird ist spätestens bei der 4.5-millionsten Datenzeile Schluß. AutoCAD lagert scheinbar alle in der MAPCAR befindlichen Daten aus, im Taskmanager hat die Auslagerungsdatei bereits eine Größe von ca. 2.5GB erreicht und der Rechner ist am dampfen. Sicherlich kann man über die Windows-Systemsteuerung die Größe der Auslagerungsdatei noch optimieren, aber so einige Versuche haben gezeigt, dass es maximal ca. 400.000 Datenzeilen mehr bringt, die in der MAPCAR-Schleife verarbeitet werden können.

Also, jetzt suche ich die Lösung nicht in der Windows-Umgebung, sondern ich ändere den LISP-Code so, dass nicht alle 12 Millionen Datenzeilen auf einmal verarbeitet werden, sondern in Häppchen von jeweils 2 Millionen Datenzeilen.

Folgende Grundüberlegung: Eine MAPCAR-Schleife läuft immer eine gesamte Liste durch, daher werde ich 2 WHILE-Schleifen verwenden. Die innere WHILE-Schleife läuft solange, bis der 2-millionste Durchlauf erreicht ist oder die Zeilen_Liste leer ist, gezählt wird mit der Variablen J. Die äußere While-Schleife wird solange durchlaufen bis die Zeilen_Liste leer ist, gezählt wird mit der Variablen I. Beim Schreiben der Datei wird das Argument „w“ beim ersten Durchlauf, bei allen folgenden Durchläufen das Argument „a“ für Anhängen (append) an vorhandene Datei verwendet.

(defun JB_Koord:WriteWithWhile (dateiname /
A DATEI I J K L WRITE_LISTE ZEILEN_LISTE)
(setq zeilen_liste (JB_Koord:Read dateiname)
j 1 ;;;Zähler 1. WHILE-Schleife
i 1.0 ;;;Zähler 2. WHILE-Schleife
)
(princ
(strcat
“: “
(menucmd “M=$(edtime,$(getvar,date),DD.MO.YYYY HH:MM:SS)”)))
(setvar “DIMZIN” 3);;;Damit nachführenden Nullen geschrieben werden
(while zeilen_liste
(while (and (<= (/ j i)2000000.0) zeilen_liste)
(setq write_liste (cons
(read (strcat”(” (car zeilen_liste)”)”))
write_liste)
j (+ j 1)
zeilen_liste (cdr zeilen_liste))
)
(princ
(strcat
“”
(itoa j)
” verarbeitet: “
(menucmd “M=$(edtime,$(getvar,date),DD.MO.YYYY HH:MM:SS)”)))
(setq datei (open dateiname (if (= i 1)”w” “a”))
write_liste (reverse write_liste))
(mapcar ‘(lambda(A)
(write-line
(strcat (rtos(+(car A)3500000.0)2 6)” “
(rtos(+(cadr A)5900000.0)2 6)” “
(rtos(caddr A)2 6))datei)
)write_liste)
(princ
(strcat
“”
(itoa j)
” geschrieben: “
(menucmd “M=$(edtime,$(getvar,date),DD.MO.YYYY HH:MM:SS)”)))
(setq i (+ i 1.0)
write_liste nil)))

Die aufrufende Funktion könnte folgendermaßen aussehen:

(defun c:JB_Koord1 ( / dateiname)
(princ
(strcat
“: “
(menucmd “M=$(edtime,$(getvar,date),DD.MO.YYYY HH:MM:SS)”)))
(setq dateiname “c:\temp\test.kor”)
(JB_Koord:WriteWithWhile dateiname)
(princ
(strcat
“: “
(menucmd “M=$(edtime,$(getvar,date),DD.MO.YYYY HH:MM:SS)”)))
)

Anmerkung:
Bei der Verarbeitung von so großen Dateien ist es sinnvoll, sich über PRINC-Anweisungen den Fortschritt anzeigen zu lassen. Im Beispiel habe ich die Zeiten ausgegeben, wenn ein Arbeitsschritt abgearbeitet worden ist.

Man könnte ja auch einen Zähler einbauen, so dass der Bearbeiter sofort sieht, die wievielte Zeile gerade aktuell geschrieben oder gespeichert wird, z.B.
(princ (strcat “Datei schreiben: ” ” (“(itoa (setq m (+ m 1)))”/” (itoa k)”)”))
Aber Achtung:
bei so großen Datenmengen ist ein solcher Zähler wirklich hinderlich. Er wirkt sich nicht nur sehr negativ auf die Performance aus, in diesem Fall, bei einer Beispiel-Datei mit über 12-Millionen Zeilen, hängt sich AutoCAD auf und muss über den Task-Manager beendet werden.

Folgende Ergebnisse sind bei einer Datei mit 12.266.233 Zeilen herausgekommen:

• Start: 29.01.2009 14:56:06
  

• Eingelesen: 29.01.2009 14:57:02
  

• 2000001 verarbeitet: 29.01.2009 14:57:41
  

• 2000001 geschrieben: 29.01.2009 14:59:18
  

• 4000001 verarbeitet: 29.01.2009 14:59:51
  

• 4000001 geschrieben: 29.01.2009 15:01:26
  

• 6000001 verarbeitet: 29.01.2009 15:02:02
  

• 6000001 geschrieben: 29.01.2009 15:03:31
  

• 8000001 verarbeitet: 29.01.2009 15:04:11
  

• 8000001 geschrieben: 29.01.2009 15:05:31
  

• 10000001 verarbeitet: 29.01.2009 15:06:07
  

• 10000001 geschrieben: 29.01.2009 15:07:25
  

• 12000001 verarbeitet: 29.01.2009 15:07:58
  

• 12000001 geschrieben: 29.01.2009 15:09:12
  

• 12266233 verarbeitet: 29.01.2009 15:09:17
  

• 12266233 geschrieben: 29.01.2009 15:09:25
  

• Fertigstellung: 29.01.2009 15:09:25″
  

Zeit ca. 13 Minuten

Computer:

• Intel® Core™2 Duo CPU
  

• T7700 @ 2.40GHz
  

• 2.39GHz, 2.00 GB RAM
  

• Start: 29.01.2009 15:49:09
  

• Eingelesen: 29.01.2009 15:55:52
  

• 2000001 verarbeitet: 29.01.2009 16:03:17
  

• 2000001 geschrieben: 29.01.2009 16:10:26
  

• 4000001 verarbeitet: 29.01.2009 16:16:38
  

• 4000001 geschrieben: 29.01.2009 16:23:39
  

• 6000001 verarbeitet: 29.01.2009 16:29:59
  

• 6000001 geschrieben: 29.01.2009 16:37:05
  

• 8000001 verarbeitet: 29.01.2009 16:42:40
  

• 8000001 geschrieben: 29.01.2009 16:49:09
  

• 10000001 verarbeitet: 29.01.2009 16:54:01
  

• 10000001 geschrieben: 29.01.2009 17:00:05
  

• 12000001 verarbeitet: 29.01.2009 17:03:38
  

• 12000001 geschrieben: 29.01.2009 17:08:38
  

• 12266233 verarbeitet: 29.01.2009 17:09:01
  

• 12266233 geschrieben: 29.01.2009 17:09:36
  

• Fertigstellung: 29.01.2009 17:09:36
  

Zeit: ca. 1 Stunde und 20 Minuten

Computer:

• AMD Athlon™ XP 3000+
  

• 600 MHz, 1.25 GB RAM
  

Codes (formatiert) in LISP-Datei

Beginnend bei einem Quellverzeichnispfad sollen alle Dateien und Unterverzeichnisse in ein Zielverzeichnis kopiert werden. Die folgenden Codes sind in ähnlicher Form bereits im CAD.de-Beitrag http://ww3.cad.de/foren/ubb/Forum145/HTML/002106.shtml diskutiert worden.

Grundsätzlich würde man bei manueller Vorgehensweise wie folgt vorgehen:

• Alle gefundenen Dateien im Quellverzeichnis würden mit Pfadangabe in eine Liste geschrieben werden.
  

• Alle gefundenen Unterverzeichnisse müssten wiederum auf Dateien und Unterverzeichnisse geprüft werden.
  

• Die Punkte 1. und 2. für jedes gefundene Unterverzeichnis solange wiederholen, bis kein Unterverzeichnis mehr gefunden wird, mühsam.
  

Daher ist es sinnvoll eine rekursive Funktion für die Suche der Dateien und Unterverzeichnisse zu erstellen. Diese ruft sich solange selbst auf, bis kein Unterverzeichnis mehr gefunden wird.

(defun JB_FolderCopy:Search (FolderFileListe SourcePath / A B Files)
;;;wenn Dateien im Quellverzeichnis
(if (setq Files (vl-directory-files SourcePath nil 1))
;;;dann FolderFileListe mit (Flag = 'T; [Quellpfad]+[Dateinamen])
(mapcar
'(lambda (A) (setq FolderFileListe (cons (list 'T (strcat SourcePath A))
FolderFileListe)))
(vl-directory-files SourcePath nil 1)
)
)
;;;FolderFileListe mit (Flag = nil; [Quellpfad])
(setq FolderFileListe (cons (list nil SourcePath) FolderFileListe))
;;;rekursiver Aufruf der Funktion "JB_FolderCopy:Search" für jedes
;;;gefundene Unterverzeichnis
(mapcar '(lambda (A)
(setq FolderFileListe (JB_FolderCopy:Search FolderFileListe
(strcat SourcePath A "\")))
)
(vl-remove-if '(lambda (B) (member B '("." "..")))
(vl-directory-files SourcePath nil -1))
)
;;;Rückgabe der gefundenen Dateien und Unterverzeichnisse
FolderFileListe
)

Als Argumente werden der Funktion JB_FolderCopy:Search eine (anfangs) leere Liste FolderFileListe mit bereits gefundenen
Datei- und Verzeichnispfaden und der jeweils aktuelle Quellpfad SourcePath übergeben.
Der Quellpfad SourcePath bildet sich bei jedem Aufruf aus dem alten Quellverzeichnis + das aktuell gefundene Unterverzeichnis.
Zurückgegeben wird die jeweils aktuelle Liste FolderFileListe.

Innerhalb der Funktion JB_FolderCopy:Search werden die gefundenen Unterverzeichnisse in einer MAPCAR-Schleife abgearbeitet. D.h., die Funtion ruft sich pro MAPCAR-Schleifendurchlauf immer selber auf. Daraus folgt wiederum, daß mehrere MAPCAR-Schleifen zur gleichen Zeit laufen.
Das folgende Bild soll dieses verdeutlichen: FolderCopyTree

Wenn man die MAPCAR-Schleifen nummeriert, beginnend bei 1, würden folgende MAPCAR-Schleifen laufen:
1 (erste Schleife)
1.1 (erste Schleife innerhalb erster Schleife)
1.1.1 (erste Schleife innerhalb erster Schleife innerhalb erster Schleife)
1.1.2 (zweite Schleife innerhalb erster Schleife innerhalb erster Schleife)
1.1.2.1 (erste Schleife …)
1.1.2.2
1.2
1.2.1
1.2.2
1.2.2.1
1.2.2.2
2

Als Rückgabe erhält man folgende Liste:


Mit dieser Liste ist es jetzt ein einfaches, anhand der Flags nil oder ‘T zu unterscheiden, ob es sich um ein Verzeichnis oder einen Dateipfad handelt. Mit den Funktion vl-mkdir werden die Unterverzeichnisse im Zielpfad erstellt, dann können die Dateien mit der Funktion vl-file-copy in die neuen Verzeichnisse kopiert werden.

Listen speichern und LOADen

Codes (formatiert) in LISP-Datei

Folgendes Problem: Fast jedes Programm sollte Benutzereinstellungen speichern. Wird das Programm wieder verwendet sind die zuletzt verwendeten Einstellungen die Vorgabeeinstellung.

Als Beispiel nehmen wir ein Programm KoordEin, welches Koordinaten aus einer Datei lesen soll. Die Benutzereinstellungen zu dem Programm werden unter c:\temp\KOORDEIN_USER.lsp gespeichert. D.h., wenn das Programm das erste mal aufstartet wird nach der Datei KOORDEIN_USER.lsp gesucht, wenn sie nicht gefunden wird, muss eine Liste mit Vorgabeeinstellungen erzeugt werden.

(if (not (findfile c:\temp\KOORDEIN_USER.lsp"))
(setq UserListe '((1 . "");;;Leereintrag für die erste Dateiauswahl
))
(setq UserListe (load "c:\temp\KOORDEIN_USER.lsp"))
)

In der UserListe werden Dottet Pair’s verwendet, damit auf die einzelnen Listeneinträge mit der Funktion ASSOC zugegriffen werden kann. So ist z.B. der Dateipfad:

(setq Pfad (cdr(assoc 1 UserListe)))

Im Programm geht es weiter mit der Dateiauswahl, es wird die Datei c:\temp\koord.txt ausgewählt. Über die Funktion SUBST wird die UserListe mit dem neuen Dateipfad aktualisiert.

(setq UserListe (subst (cons 1 pfad)(assoc 1 UserListe)UserListe)

Jetzt ist der zuletzt verwendete Pfad in der UserListe gespeichert. Bevor das Programm jetzt aber beendet wird, muss diese Liste in die Datei c:\temp\KOORDEIN_USER.lsp gesichert werden. Das geschieht mit der selbstgeschriebenen Funktion KoordEin:UserListe:Write.

(defun KoordEin:UserListe:Write (UserListe Pfad / Datei)
(setq Datei (open Pfad "w"))
(write-line "'(" Datei)
(mapcar '(lambda (A)
(prin1 A Datei))
UserListe)
(write-line ")" Datei)
(close Datei)
)

Dabei wird  in die erste Zeile eine apostophierte, öffnende Klammer vorangestellt, dann die UserListe mit der Funktion PRIN1 in einer MAPCAR-Schleife geschrieben (es sind in der Regel mehr Werte als nur ein Dateipfad zu speichern, daher die Schleife), zum Schluß wird eine schließende Klammer geschrieben. Als Ergebnis liegt jetzt eine LSP-Datei im Listenformat vor, die mit der Funktion LOAD geladen werden kann. Das Programm könnte dann wie folgt aufgebaut sein:

(defun c:KoordEin ( / Pfad UserListe)
(if (not (findfile "c:\temp\KOORDEIN_USER.lsp"))
(setq UserListe '((1 . "") ;;;Leereintrag für die erste Dateiauswahl ))
(setq UserListe (load "c:\temp\KOORDEIN_USER.lsp"))
)
(if (setq Pfad (getfiled "Koordinatendatei wählen:"
(cdr (assoc 1 UserListe)) "*" 4))
(progn
(setq UserListe (subst (cons 1 Pfad) (assoc 1 UserListe) UserListe))
(BearbeiteDieKoordinaten Pfad)
(KoordEin:UserListe:Write UserListe "c:\temp\KOORDEIN_USER.lsp"))
))