Hot News:

Mit Unterstützung durch:

  Foren auf CAD.de (alle Foren)
  Rund um AutoCAD
  Lisp-->Attribute-->Werte finden und ersetzen

Antwort erstellen  Neues Thema erstellen
CAD.de Login | Logout | Profil | Profil bearbeiten | Registrieren | Voreinstellungen | Hilfe | Suchen

Anzeige:

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen nächster neuer Beitrag | nächster älterer Beitrag
  
Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte
Autor Thema:  Lisp-->Attribute-->Werte finden und ersetzen (2394 mal gelesen)
benwisch
Mitglied
Bautechniker, CAD-Konstrukteur


Sehen Sie sich das Profil von benwisch an!   Senden Sie eine Private Message an benwisch  Schreiben Sie einen Gästebucheintrag für benwisch

Beiträge: 375
Registriert: 01.02.2001

Autocad 2005-2010
Microstation V8
Photoshop CS4 + Camera Raw
Nikon Capture NX2
Nikon D90

erstellt am: 01. Nov. 2002 08:33    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

ich möchte eine kleine lisp-routine schreiben, bei dem es mir möglich ist, einen attributswert eines blockes (soll durch picken bestimmt werden) zu finden und diesen zu ersetzen. der block beinhaltet ein attribut, daß stückzahl heisst. dort ist eine zahl gespeichert. nun möchte ich diesen wert mit einem wert meiner wahl subtrahieren oder addieren.

ich scheitere aber schon am auslesen. wenn ich mir das überwachungsfenster betrachte, tippe ich mal auf tblsearch....

würde mich über hilfe freuen !

------------------
"Gott muß verrückte Menschen lieben"
"Warum ?"
"Er macht so viele davon !"

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

marc.scherer
Ehrenmitglied V.I.P. h.c.
CAD-Administrator



Sehen Sie sich das Profil von marc.scherer an!   Senden Sie eine Private Message an marc.scherer  Schreiben Sie einen Gästebucheintrag für marc.scherer

Beiträge: 2494
Registriert: 02.11.2001

Windows 10 64bit
AutoCAD Architecture 2018/2019 (deu/eng)
AEC-Collection 2019 (Revit und Zeugs)
Wenn sich's nicht vermeiden läßt:
D-A-CH Erweiterung (mies implementierter Schrott)

erstellt am: 01. Nov. 2002 10:04    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für benwisch 10 Unities + Antwort hilfreich

Hi Benwisch,
check mal diesen Code an,
da müßtest Du alles drin finden was Du für sowas brauchst...
Code:

;;; ***********************************************************************
;;; * ATT-CLONE dient zum Übertragen von Attributwerten eines Blockes auf *
;;; * beliebige 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...")
(c:Att-Clone)
(princ)



.

------------------
Ciao,
Marc

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

wkopp@ccc.gr
Mitglied
senior electrical designer


Sehen Sie sich das Profil von wkopp@ccc.gr an!   Senden Sie eine Private Message an wkopp@ccc.gr  Schreiben Sie einen Gästebucheintrag für wkopp@ccc.gr

Beiträge: 432
Registriert: 02.04.2002

erstellt am: 01. Nov. 2002 10:33    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für benwisch 10 Unities + Antwort hilfreich

Hi Benwisch,
wenns nicht zuviel Arbeit ist, wuerde ich die Befehle Attout und Attin von den E-Tools empfehlen. Der Vorteil ist, dass diese Attr. Werte in Exel eingelesen werden koennen und dort ist es eben einfach einen Wert mit einer Zahl zu subtrahieren oder multiplizieren. Danach einfach wieder in *.txt Datei speichern und geaenderte Attributswerte wieder in ACAD einlesen.
Hope it helps
Ach ja, ich dachte heute ist Feiertag in Deutschland. Warum arbeitest denn Du? Geniess den Feiertag 

------------------
Gruss aus dem sonnigen Athen
Wolfgang

[Diese Nachricht wurde von wkopp@ccc.gr am 01. November 2002 editiert.]

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

benwisch
Mitglied
Bautechniker, CAD-Konstrukteur


Sehen Sie sich das Profil von benwisch an!   Senden Sie eine Private Message an benwisch  Schreiben Sie einen Gästebucheintrag für benwisch

Beiträge: 375
Registriert: 01.02.2001

Autocad 2005-2010
Microstation V8
Photoshop CS4 + Camera Raw
Nikon Capture NX2
Nikon D90

erstellt am: 01. Nov. 2002 12:04    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

@marc
habe mal kurz überflogen und meine fündig geworden zu sein :-))
werde mir dein bsp. mal genauer ansehen. vielen dank hierzu....
und ich bekomme ein schlechtes gewissen, denn ich sehe du hast sehr viele fehlermöglichkeiten berücksichtigt....ich weiss ja nicht wie es den anderen geht, aber ich drücke mich irgendwie so ein bisschen davor (nur das allernötigste)...faulheit ?? ;-)

@wkopp
ja, das geht, aber das ist nicht das was ich will....sol ja eigentlich kurz und schmerzlos sein. auch den code studierte ich, wobei mir diese acet-dingenskirchen noch mehr fragezeichen hervorrufen.
....feiertag.....ich arbeite in hessen....die sind mit ihren feiertagen sehr sparsam :-( ....

------------------
"Gott muß verrückte Menschen lieben"
"Warum ?"
"Er macht so viele davon !"

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

Anzeige.:

Anzeige: (Infos zum Werbeplatz >>)

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen

nächster neuerer Beitrag | nächster älterer Beitrag
Antwort erstellen


Diesen Beitrag mit Lesezeichen versehen ... | Nach anderen Beiträgen suchen | CAD.de-Newsletter

Administrative Optionen: Beitrag schliessen | Archivieren/Bewegen | Beitrag melden!

Fragen und Anregungen: Kritik-Forum | Neues aus der Community: Community-Forum

(c)2023 CAD.de | Impressum | Datenschutz