---

Hallo,

brauche diese Hilfe, um den Code vom Tool ATT-Clone anzupassen.

Ich möchte dabei die Blöcke, welche die Attributwerte des zuerst angeklickten Source-Blocks übernehmen sollen, nicht anklicken müssen, sondern per Auswahlrechteck markieren. Sonst müsste ich zig tausendmal klicken. Hier der Code von ATT-Clone:

;;; ***********************************************************************
;;; * ATT-CLONE dient zum Übertragen von Attributwerten eines Blockes auf *
;;; * beleibige andere Blöcke.                                            *
;;; * Bei identischen "Feldnamen" (also AttributNAMEN) wird der Wert des  *
;;; * Quellblocks als Wert des zu klickenden Zielblocks eingetragen.      *
;;; * Versuch's mit der dem Original-Zip Archiv beiliegenden              *
;;; * "Test-Att-Clone.dwg"                                                *
;;; *                                                                    *
;;; * Written by Marc Scherer in 2002                                    *
;;; *                                                                    *
;;; * Anregungen/Kritik an "marc.scherer@zvo.com"                        *
;;; *                                                                    *
;;; * Dieses Programm folgt der "Better than Nothing" Philosophie des    *
;;; * Leonid Nemirovsky: (http://home.pacifier.com/~nemi/)                *
;;; * Zitat:                                                              *
;;; * The AutoLISP programs you are about to check - are NOT shareware    *
;;; * or freeware. They are BTN - Better Than Nothing Software.          *
;;; * You can freely use them in any way you choose.                      *
;;; * Just remember one thing.......                                      *
;;; * If they do not perform the way you expect -                        *
;;; *                                it is still BETTER THAN NOTHING !!!  *
;;; * I wrote those programs for my every day work.                      *
;;; * Some of them are more useful, some - are SO SO.                    *
;;; * ... Good Luck !                                                    *
;;; ***********************************************************************

;;; Funktionsaufruf zum Pinselübertragen
;;; Überträgt Attributwerte von einem Quellblock auf beliebig
;;; viele Zielblöcke
(defun C:ATT-CLONE (/ ATT-LST CHK OBJ OBJ-DATA)
  (while
    (/= (if (setq OBJ
                  (car
                    (entsel
                      "\nBitte Quellblock für Attributwert-Übertragung wählen: "
                    ) ;_ end of entsel
                  ) ;_ end of car
            ) ;_ end of setq
          (progn
            (setq CHK (cdr (assoc 0 (setq OBJ-DATA (entget OBJ)))))
            (if (/= CHK "INSERT")
              (princ "\nKein BLOCK-Objekt geklickt, versuch's noch einmal...")
            ) ;_ end if
            CHK
          ) ;_ end of progn
          (princ "\nNICHTS geklickt, versuch's noch einmal...")
        ) ;_ end of if
        "INSERT"
    ) ;_ end of /=
  ) ;_ end of while
  (if OBJ-DATA
    (progn
      (if (CHK-ENT OBJ)
        (progn
          (setq ATT-LST (ALL-BL-TXT OBJ))
          (if (not ATT-LST)
            (princ
              "\nQuell-Block enthält keinerlei Attributsdaten... Funktionsende !"
            ) ;_ end princ
            (progn
              (while (setq OBJ
                            (car
                              (entsel
                                "\nBitte Zielblock für Attributwert-Übertragung wählen (R.Klick=Ende): "
                              ) ;_ end of entsel
                            ) ;_ end of car
                    ) ;_ end of setq
                (if (CHK-ENT OBJ)
                  (progn
                    (if (assoc 66 (entget OBJ))
                      (progn
                        (foreach ELEM ATT-LST
                          (princ (ED-ATT ELEM OBJ))
                        ) ;_ end foreach
                      ) ;_ end progn
                      (princ "\nZielblock enthält keine Attribute !")
                    ) ;_ end if
                  ) ;_ end progn
                  (princ "\nObjekt war KEIN Block oder UNGÜLTIG!")
                ) ;_ end of if
              ) ;_ end of while             
            ) ;_ end progn
          ) ;_ end if
        ) ;_ end progn
        (princ "\nObjekt war KEIN Block oder UNGÜLTIG!")
      ) ;_ end of if
    ) ;_ end of progn
  ) ;_ end of if
  (princ)
) ;_ end defun

;;; Funktion checkt, ob Objekt ein regulärer Block oder'n Xref
;;; ist, bzw. ob's überhaupt 'n Insert ist...
;;; Rückgabe: Wenn kein Block, dann nil, ansonsten Ausgabe wie Eingabe
(defun CHK-ENT (ENT / ENT-DATA)
  (if (= (type ent) 'ENAME)
    (setq ent-data (entget ent))
    (setq ent-data (entget (car ent)))
  ) ;_ end of if
  (cond
    ((= (cdr (assoc 0 ENT-DATA))
        "INSERT"
    ) ;_ end =
    (if
      (>= (cdr (assoc 70 (tblsearch "BLOCK" (cdr (assoc 2 ENT-DATA))))
          ) ;_ end cdr
          4
      ) ;_ Wenn T dann Xref!!!
        (progn
          (princ
            "\nGeklicktes Objekt war ein XREF. Versuch's noch mal..."
          ) ;_ end princ
          (setq ENT NIL)
        ) ;_ end progn
        (setq ENT ENT)
    ) ;_ end if
    )
    (t
    (princ
      "\nGeklicktes Objekt war KEIN Block. Versuch's noch mal..."
    ) ;_ end princ
    (setq ENT NIL)
    )
  ) ;_ end cond
  ENT
) ;_ end defun

;;; Funktion tauscht Attributwerte aus.
;;; Zu übergeben ist eine cons List aus
;;; ("ATTBEZEICHNUNG" . "NEUER TEXTWERT")
;;; sowie der Elementname des Blocks, dessen Werte verändert werden sollen
(defun ED-ATT (CHANGELST OBJNAME / ATTNAME BACK CHK OBJDATA TXTWRT)
  (setq ATTNAME (car CHANGELST)
        TXTWRT  (cdr CHANGELST)
        OBJDATA (entget OBJNAME)
  ) ;_ end of setq
  (while (/= (cdr (assoc 0 OBJDATA)) "SEQEND")
    (setq OBJDATA (entget (entnext (cdr (assoc -1 OBJDATA)))))
    (if (eq (cdr (assoc 2 OBJDATA)) ATTNAME)
      (progn
        (setq OBJDATA (subst (cons 1 TXTWRT) (assoc 1 OBJDATA) OBJDATA))
        (entmod OBJDATA)
        (setq CHK (entupd OBJNAME)
              OBJDATA (list (cons 0 "SEQEND"))
        ) ;_ end setq
      ) ;_ end progn
    ) ;_ end if
  ) ;_ end while
  (if CHK
    (setq BACK (strcat "\nWert: \""      TXTWRT
                      "\" für: \""      ATTNAME
                      "\" eingesetzt..."
                      ) ;_ end strcat
    ) ;_ end of setq
    (setq BACK
          (strcat "\nFeld: \"" ATTNAME "\" im Zielblock nicht vorhanden...")
    ) ;_ end of setq
  ) ;_ end of if
  BACK
) ;_ end of defun

;;; Funktion durchsucht den Block, der über ename übergeben wird,
;;; nach ATTRIB's und erzeugt 'ne Textliste
;;; Retval: Liste der Texte oder nil
(defun ALL-BL-TXT (ENAME / EDATA RETVAL)
  (setq RETVAL '() ;_ Liste initialiseren
        EDATA  (entget ENAME)
  ) ;_ end setq
  (if (assoc 66 EDATA) ;_ GC 66 fehlt, wenn Block keine Attrib's hat
    (progn
      (while (/= (cdr (assoc 0 EDATA)) "SEQEND") ;_ Solange die Sequenz nicht endet...
        (setq EDATA (entget (entnext (cdr (assoc -1 EDATA)))))
        (if (= (cdr (assoc 0 EDATA)) "ATTRIB")
          (setq RETVAL
                (cons
                  (cons (cdr (assoc 2 EDATA)) (cdr (assoc 1 EDATA)))
                  RETVAL
                ) ;_ end cons
          ) ;_ end setq
        ) ;_ end if
      ) ;_ end while
      (setq RETVAL (reverse RETVAL))
    ) ;_ end progn
  ) ;_ end if
  RETVAL
) ;_ end defun

(princ "\n\"ATT-CLONE\"->\"Pinselübertragung\" von Attribut-WERTEN...")

(princ)

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

---

Dann schreib das Marc. Dafür gibt es die PM-Funktion.

P.S: übrigens ist Crossposting    

------------------
      - Thomas -
"Bei 99% aller Probleme ist die umfassende Beschreibung des Problems bereits mehr als die Hälfte der Lösung desselben."

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

---

Wenn DU es nicht ändern kannst , es sich aber um tausende Blockreferenzen eines Blockes handelt,
warum markierst du sie dann nicht einfach trägst 1x die korrekten Werte über das Eigenschaften-Fenster ein ???
Nur so ein Vorschlag..

------------------
die alte SUCHfunktion.. - System-Angaben - User:FAQ(Adesk)

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

---

Weil es auch extrem viele Attribute sind...

Sorry für das Cross-Posting   ich versuche den thread zu löschen. hatte beim ersten Mal einfach im falschen Forum gepostet.

[Diese Nachricht wurde von toXin am 04. Apr. 2007 editiert.]

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

---

wie weit bist du denn schon gekommen, bei deinen Eigenversuchen?

Ich denke, du solltest dir die AutoLISP-Befehle
(ssget ..) in Verbindung mit der Filterliste ansehen.
Dann brauchst du eigentlich nur noch die (while -Schleife für die Elemente des Auswahlsatzes durchlaufen.

(setq Auswahlsatz(ssget ..))
(while Auswahlsatz
(setq OBJ (ssname Auswahlsatz 0)
Auswahlsatz (ssdel OBJ Auswahlsatz)
)
...

Alles klar?

Grüße Holger

------------------
Holger Brischke
CAD on demand GmbH
Individuelle Lösungen von Heute auf Morgen.

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

---

@Brischke

Danke!

Ich muss jedoch zu meiner Schande zugeben, dass ich absolut keine Ahnung von LISP habe - es aber wohl Zeit wird, sich damit zu beschäftigen. Ich verstehe sehr wohl, dass ich hier nicht einfach nur "für mich arbeiten" lassen darf- dafür entschuldige ich mich.

Dann wird jetzt erstmal... weiterge"klickt". 

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

---

 

Zitat:

---

Original erstellt von toXin:
@Brischke

Danke!

Ich muss jedoch zu meiner Schande zugeben, dass ich absolut keine Ahnung von LISP habe - es aber wohl Zeit wird, sich damit zu beschäftigen. Ich verstehe sehr wohl, dass ich hier nicht einfach nur "für mich arbeiten" lassen darf- dafür entschuldige ich mich.

Dann wird jetzt erstmal... weiterge"klickt".   

---

Top-Einstellung .. vielleicht findet Marc ja die Zeit , sein Tool für dich anzupassen. Vielleicht möchtest du aber in der Zwischenzeit einen kleinen Einstieg in Lisp? .. dann ist Mapcars Tutorial ein Muss!

------------------
      - Thomas -
"Bei 99% aller Probleme ist die umfassende Beschreibung des Problems bereits mehr als die Hälfte der Lösung desselben."

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

---

super,danke, da werde ich mich gleich mal reinlesen 

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

---

at.vlx.txt

mit dem hier müßte es auch funktionieren.

Ciao Georg

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

---

hallo gmk, danke  - nur ich bekomme folgende fehlermeldung, nachdem ich die Zielobjekte ausgewählt habe und mit enter bestätigt habe:

; Fehler: no function definition: AWS_NACH_LISTE

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

---

at.vlx.txt

sorry

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

---

suuuper,funtioniert, recht herzlichen dank!!! 

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

---

".. dann ist Mapcars Tutorial ein Muss!"
... und demnächst sein Buch!!!

Gruß
Theodor

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