Lambda-Ausdrücke sind in AutoLisp von einer so enormen
Wichtigkeit, dass ich diesem Thema noch ein weiteres
Kapitel widmen möchte. Hier soll es um ein ganz praktisches
AutoCAD-Thema gehen, mit dem eigentlich jeder, der in
AutoLisp Programme schreibt, schon einmal zu tun hatte.
Es geht um folgendes: Die Eigenschaften von Unterelementen
von Blockdefinitionen sollen abgeändert werden, ohne dass
die Blöcke noch einmal zerlegt werden müssen.
Ich möchte hier zeigen, wie mit wenig Programmcode, aber
durch den massiven Einsatz von lambda-Ausdrücken, ein
sehr hohes Mass an Flexibilität erreicht werden kann. Mit
den hier vorgestellten Funktionen kann man beispielsweise
-
... erst einmal bestimmte Blockdefinitionen filtern,
d.h. es werden nur Blöcke bearbeitet, die einem
mitzugebenden Kriterium entsprechen, z.B. einem
Namens-Filter, keine anonymen usw.
-
... zu jedem der gefundenen Blöcke eine Liste mit
den Unterelementen erstellen
-
... die Unterelemente ebenfalls filtern: Nur ATTDEFs,
nur alte Polylinien, nur grüne Kreise oder gelbe Linien
usw.
-
... und schliesslich auf diese Entities einen Ausdruck
anwenden, der ihre Eigenschaften verändert (z.B. auf
einen anderen Layer legen, löschen, XData anbringen usw.
Falls jetzt jemand eine Unmenge von Code erwartet - nein,
das muss nicht sein! Wir benötigen eigentlich nur zwei
grundsätzliche Funktionen, die auch noch recht kurz und
übersichtlich ausfallen. Allerdings enthalten natürlich
auch die zu übergebenden lambda-Ausdrücke auch noch eine
mehr oder weniger grosse Menge Code.
Die erste der beiden Funktion ist ganz allgemeiner Natur:
Mit ihr kann man aus Tabellen (sie ist nicht auf die
Blocktabelle beschränkt) bestimmte Einträge heraussuchen,
die dem mitgegebenen lambda-Ausdruck entsprechen:
; Gibt alle Tabelleneinträge in einer
; Tabelle (z.B. Blocktabelle) zurück
(defun all-table-entries-if
(table condition / rover list-of-entries)
(setq rover(tblnext table 'T))
(while rover
(if(apply condition(list rover))
(setq list-of-entries
(cons(cdr(assoc 2 rover))list-of-entries)
)
)
(setq rover(tblnext table))
)
list-of-entries
)
Die Funktion bekommt als erstes Agument den Namen der
Tabelle (z.B. "BLOCK" oder "LAYER").
Das zweite Argument ist der Lambda-Ausdruck, mit dem wir
uns etwas näher befassen sollten. Diese lambda-expression
muss eine Funktion sein, die ein einziges Argument erhält:
Die Liste mit den Geometriedaten, wie
(tblnext ...)
sie in der Blocktabelle vorfindet.
Diese Datenliste kann die lambda-Funktion nun irgendwie
untersuchen: Gibt sie
T zurück, wird die Blockdefinition
in die Ergebnisliste aufgenommen, gibt sie
nil zurück,
bleibt der Block liegen und wird ignoriert. Eine solche
Geometriedaten-Liste kann z.B. so aussehen:
((0 . "BLOCK") (2 . "test") (70 . 0) (10 0.0 0.0 0.0)
(-2 . <Objektname: 40083d70>))
Hier ergeben sich schon eine ganze Menge Ansatzpunkte für
das Filtern. Dazu ein paar Beispiele, wie die Funktion mit
verschiedenen Ausdrücken aufgerufen werden kann:
; Alle Blöcke, deren Name mit
; "XYZ" anfängt
(all-table-entries-if "BLOCK"
'(lambda(data / )
(wcmatch(cdr(strcase(assoc 2 data)))"XYZ*")
)
)
; Keine externen Referenzen!
(all-table-entries-if "BLOCK"
'(lambda(data / )
(zerop(logand(cdr(assoc 70 data))4))
)
)
; Die Kombination aus den beiden
; vorigen Beispielen
(all-table-entries-if "BLOCK"
'(lambda(data / )
(and
(zerop(logand(cdr(assoc 70 data))4))
(wcmatch(cdr(strcase(assoc 2 data)))"XYZ*")
)
)
)
; Alle Blöcke auf Layer "0"
(all-table-entries-if "BLOCK"
'(lambda(data / )
(= "0"(cdr(assoc 8 data)))
)
)
; Alle Blöcke, wie sie gefunden werden
; dieser lambda-ausdruck gibt immer
; T zurück
(all-table-entries-if "BLOCK"
'(lambda(data / ) 'T)
)
Ein paar Worte noch zur Funktion selbst: Da passiert
eigentlich gar nichts aufregendes. Die entsprechende
Tabelle wird vom Anfang bis zum Ende mit
(tblnext ...)
durchkämmt, und auf jeden Eintrag wird der lambda-Ausdruck
angewendet. Wie gesagt, diese Funktion kann auf alle
Tabellen angewendet werden. Ein Eintrag in der Layertabelle
könnte etwa so aussehen:
((0 . "LAYER") (2 . "0") (70 . 0)
(62 . 7) (6 . "Continuous"))
Und hier zwei Beispiele, wie man Layer nach dem Namen
oder anderen Kriterien filtern könnte:
; Alle Layer, deren Name länger als
; 25 Zeichen ist
(all-table-entries-if "LAYER"
'(lambda(data / )
(> (strlen(cdr(assoc 2 data))) 25)
)
)
; Alle gefrorenen oder ausgeschalteten Layer
; Hinweis: Bei ausgeschalteten Layern ist die
; Farbnummer negativ!
(all-table-entries-if "LAYER"
'(lambda(data / )
(or
(not(zerop(logand(cdr(assoc 70 data))1)))
(<(cdr(assoc 62 data))0)
)
)
)
Nun aber zur zweiten Funktion, die wir zum Bearbeiten
der Block-Subentitities benötigen. Diese Funktion ist
natürlich nur für die Blocktabelle. Sie bekommt als
erstes Argument den Blocknamen, auf den sie mit
(tblsearch ...)
zugreift, und als zweites Argument... na, was wohl?
; Ermittelt zu einem Blocknamen alle Sub-Entities,
; die der übergebenen Bedingung entsprechen
(defun gather-subents-if(blockname condition /
rover subents)
(setq rover
(cdr(assoc -2(tblsearch"block"blockname)))
)
(while rover
(if(apply condition(list(entget rover)))
(setq subents(cons rover subents))
)
(setq rover(entnext rover))
)
subents
)
Die Funktion arbeitet ähnlich wie die erste, mit dem
Unterschied, dass hier natürlich nicht auf die Blocktabelle
selbst, sondern auf die Folge von Sub-Entities zu einem
Block zugegriffen wird. Trotzdem: Auch hier wieder das
Durchlaufen bis zum Ende und das Prüfen der Testbedingung.
Da die an den lambda-Ausdruck zum Testen übergebenen
Datenlisten ganz normal sind (sie unterscheiden sich ja
überhaupt nicht von denen anderer Geometrie-Elemente),
können wir sofort mit Anwendungsbeispielen fortfahren:
; Alle Subentities des Blocks "Schraube",
; die rote Linien sind
(gather-subents-if "schraube"
'(lambda(data / )
(and
(= "LINE"(cdr(assoc 0 data)))
(= 1(cdr(assoc 62 data)))
)
)
)
; Alle Subentities des Blocks "Test",
; die Linien von mehr als 1000 Länge sind
(gather-subents-if "Test"
'(lambda(data / )
(and
(= "LINE"(cdr(assoc 0 data)))
(>
(distance
(cdr(assoc 10 data))
(cdr(assoc 11 data))
)
1000
)
)
)
)
; Alle ATTDEFs im Block "Test"
(gather-subents-if "Test"
'(lambda(data / )
(= "ATTDEF"(cdr(assoc 0 data)))
)
)
Das waren also die beiden Funktionen, die wir
grundsätzlich benötigen, um unser Problem anzugehen.
Damit können wir jetzt beispielsweise diese
Änderungen in einer Zeichnung durchführen: Die
nachfolgend vorgestellte Funktion setzt alle in der
Zeichnung vorhandene ATTDEFs, die auf Layer 0 liegen,
auf den Layer "Attdefs" um.
(defun attdef-test( / )
(foreach block
(all-table-entries-if"block"
; Die anonymen Blöcke sowie solche
; der Applikation "XYZ" werden hier
; gleich herausgefiltert
'(lambda(data / )
(not
(wcmatch
(cdr(assoc 2 data))
"XYZ*,`**"
)
)
)
)
(foreach subent
(gather-subents-if block
'(lambda(data / )
(and
(="ATTDEF"(cdr(assoc 0 data)))
(="0"(cdr(assoc 8 data)))
)
)
)
(entmod
(subst
(cons 8 "Attdefs")
(assoc 8 subent)
subent
)
)
)
)
)
Wer hier Schwierigkeiten mit "`**" hatte, sollte in der
AutoLisp-Hilfe unter
(wcmatch ...) nachsehen! Falls
das Zeichen nicht richtig dargestellt wird: Kein Hochkomma,
sondern ein 'accent grave' oder 'reverse quote' - ASCII 96!