Hot News:

Mit Unterstützung durch:

  Foren auf CAD.de (alle Foren)
  Lisp
  In LiSP: statt Klicken soll ein Auswahlrechteck her

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:  In LiSP: statt Klicken soll ein Auswahlrechteck her (1435 mal gelesen)
toXin
Mitglied



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

Beiträge: 20
Registriert: 16.08.2006

erstellt am: 04. Apr. 2007 13:36    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

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

CADmium
Moderator
Maschinenbaukonstrukteur




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

Beiträge: 13508
Registriert: 30.11.2003

.

erstellt am: 04. Apr. 2007 13:38    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 toXin 10 Unities + Antwort hilfreich

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

cadffm
Moderator
良い精神




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

Beiträge: 21533
Registriert: 03.06.2002

Alles

erstellt am: 04. Apr. 2007 13:40    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 toXin 10 Unities + Antwort hilfreich

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

toXin
Mitglied



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

Beiträge: 20
Registriert: 16.08.2006

erstellt am: 04. Apr. 2007 13:43    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

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

Brischke
Moderator
CAD on demand GmbH




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

Beiträge: 4171
Registriert: 17.05.2001

AutoCAD 20XX, defun-tools (d-tools.eu)

erstellt am: 04. Apr. 2007 14: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 toXin 10 Unities + Antwort hilfreich

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

toXin
Mitglied



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

Beiträge: 20
Registriert: 16.08.2006

erstellt am: 04. Apr. 2007 14:23    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

@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

CADmium
Moderator
Maschinenbaukonstrukteur




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

Beiträge: 13508
Registriert: 30.11.2003

.

erstellt am: 04. Apr. 2007 14:29    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 toXin 10 Unities + Antwort hilfreich

 
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

toXin
Mitglied



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

Beiträge: 20
Registriert: 16.08.2006

erstellt am: 04. Apr. 2007 14:43    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

super,danke, da werde ich mich gleich mal reinlesen 

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

gmk
Mitglied
Dipl.-Ing.(FH) Vermessung


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

Beiträge: 667
Registriert: 23.10.2002

Autocad 2004, WS CadCompass, Normica V2000, WinXP Prof., AMD Athlon 64 X2, 2GB, NVIDIA GeForce 7600GS, HP1055CM

erstellt am: 04. Apr. 2007 16:01    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 toXin 10 Unities + Antwort hilfreich


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

toXin
Mitglied



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

Beiträge: 20
Registriert: 16.08.2006

erstellt am: 04. Apr. 2007 16:32    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

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

gmk
Mitglied
Dipl.-Ing.(FH) Vermessung


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

Beiträge: 667
Registriert: 23.10.2002

Autocad 2004, WS CadCompass, Normica V2000, WinXP Prof., AMD Athlon 64 X2, 2GB, NVIDIA GeForce 7600GS, HP1055CM

erstellt am: 04. Apr. 2007 16:58    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 toXin 10 Unities + Antwort hilfreich

toXin
Mitglied



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

Beiträge: 20
Registriert: 16.08.2006

erstellt am: 04. Apr. 2007 17: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

suuuper,funtioniert, recht herzlichen dank!!! 

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

Theodor Schoenwald
Ehrenmitglied



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

Beiträge: 1672
Registriert: 16.04.2002

erstellt am: 04. Apr. 2007 19:05    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 toXin 10 Unities + Antwort hilfreich

".. 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

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