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!