---

hi

hab das lisp "einfarb" von CADwiesel. brächte aber eine kleine Änderung in dem Lisp.
Ich habe schon versucht es selbst zu ändern, aber dann hat das lisp nicht mehr funktioniert.

das lisp stellt zuerst eine abfrage, welche objekte man einfärben will. genau das will ich ändern.

ich will die Objekte zuerst auswählen und dann das lisp aufrufen.
Dann sollte dieAuswahl eingefärbt werden.

hoff ihr könnt mir helfen.

danke.

--------

(defun C:einfarb (/        SS1      SS1Len  i        NumChg  EName
                  Elist    EType    ZNACZNIK MD_ERR  M:FEHLER m:farbe
                  )
  (setq MD_ERR  *ERROR*
        *ERROR* M:FEHLER
        ) ;_ end of setq
  ;;Marke für Zurück nach Abbruch setzen
  (command "_.UNDO" "_MARK")
  (setvar "cmdecho" 0)
  (setvar "tilemode" 1)
  (command "_.-Layer" "_unlock" "*" "")
  (prompt
    "\nElemente wählen zum ändern, oder Return für alle... "
    ) ;_ end of prompt
  (setq SS1 (ssget))
  (if
    (null SS1)
    (setq
      SS1 (ssget "X" '((-4 . "<NOT") (0 . "VIEWPORT") (-4 . "NOT>")))
      ) ;_ end of setq
    ) ;_ end of if
  (if ss1
    (progn
      (prompt
        "\nObjekt für Farbe picken, oder Return für Farbwahl:"
        ) ;_ end of prompt
      (setq M:Lay (entsel))
      (if (null M:LAY)
        (progn
          (setq m:farbe (acad_colordlg 256))
          (if (null m:farbe)
            (prompt
              "\nDu musst schon 'ne Farbe wählen sonst wird das nix."
              ) ;_ end of prompt
            ) ;_ end of if
          ) ;_ end of progn
        (progn
          (if
            (null (assoc 62 (entget (car M:LAY))))
            (setq m:farbe
                    (cdr
                      (assoc
                        62
                        (tblsearch "LAYER"
                                  (cdr (assoc 8 (entget (car M:LAY))))
                                  ) ;_ end of tblsearch
                        ) ;_ end of assoc
                      ) ;_ end of cdr
                  ) ;_ end of setq
            (setq m:farbe (cdr (assoc 62 (entget (car M:LAY)))))
            ) ;_ end of if
          ) ;_ end of progn
        ) ;_ end of if
      (M:ARBEITE m:farbe)
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of defun
(defun M:ARBEITE (m:farbe /)
  (setq SS1Len (sslength SS1)
        i      0
        NumChg 0
        ) ;_ end of setq
  (prompt "\n  Arbeite.")
  (terpri)
  (while (< i SS1Len)
    (cond
      (ZNACZNIK
      (setq ZNACZNIK NIL)
      (princ (strcat (itoa NumChg) "\r \\ "))
      )
      (t
      (setq ZNACZNIK
              (princ (strcat (itoa NumChg) "\r / "))
            ) ;_ end of setq
      )
      ) ;_ end of cond
    (setq EName (ssname SS1 i)
          EList (entget EName)
          EType (cdr (assoc 0 EList))
          ) ;_ end of setq
    (cond
      ((= EType "INSERT")
      (setq
        EList (zeroz 62 EList M:farbe)
        ) ;_ end of setq
      (if (null (tblsearch "BLOCK" (cdr (assoc 2 EList))))
        (progn
          (setq EARX_BTAA (tblnext "BLOCK" T))
          (while
            (/= EARX_BTAA nil)
              (if
                (wcmatch (cdr (assoc 2 EARX_BTAA)) (cdr (assoc 2 EList)))
                (progn
                  (setq EARX_BTAB EARX_BTAA)
                  (setq EARX_BTAA nil)
                  ) ;_ end of progn
                (setq EARX_BTAA (tblnext "BLOCK"))
                ) ;_ end of if
              ) ;_ end of while
          ) ;_ end of progn
        (setq EARX_BTAB (tblsearch "BLOCK" (cdr (assoc 2 EList))))
        ) ;_ end of if
      (setq EARX_BLK (cdr (assoc -2 EARX_BTAB)))
      (while EARX_BLK
        (cond
          (ZNACZNIK (setq ZNACZNIK NIL) (princ "\r \\ "))
          (t (setq ZNACZNIK (princ "\r / ")))
          ) ;_ end of cond
        (setq ELIST (entget EARX_BLK)
              EType (cdr (assoc 0 EList))
              ) ;_ end of setq
        (setq EList (zeroz 62 EList M:farbe))
        (if ELIST
          (entmod ELIST)
          ) ;_ end of if
        (entupd ENAME)
        (setq EARX_BLK (entnext EARX_BLK))
        ) ;_ end of while
      (if (= (cdr (assoc 66 (setq EList (entget ENAME)))) 1)
        (while (/= (cdr (assoc 0 EList)) "SEQEND")
          (setq
            EList (zeroz 62 EList M:farbe)
            EList (entget (entnext (cdr (assoc -1 EList))))
            ) ;_ end of setq
          (entupd ENAME)
          ) ;_ end of while
        ) ;_ end of if
      )
      (T
      (setq EList (zeroz 62 EList M:farbe))
      )
      ) ;_ end of cond
    (setq i (1+ i))
    ) ;_ end of while
  (vla-regen
    (vla-get-activedocument
      (vlax-get-acad-object)
      ) ;_ end of vla-get-activedocument
    acAllViewports
    ) ;_ end of vla-regen
  (princ)
  ) ;_ end of defun

(prompt
  "\nProgramm zum Verändern aller ausgewählten Objekte auf eine auszuwählende Farbe.\nAufruf des Programms mit: \"einfarb\" !"
  ) ;_ end of prompt
(princ) ;_ Fängt das nil vom prompt ab

(defun M:FEHLER (MSG)
  (command "_.UNDO" "_BACK")
  (setq *ERROR* MD_ERR)
  (princ
    (strcat "Fehler! AutoCAD meldet: \"" MSG "\" als Ursache.")
    ) ;_ end of princ
  (princ)
  ) ;_ end of defun

(defun zeroz (key ZEList col / OPList NPList)
  (if (= (cdr (assoc 0 ZEList)) "ATTRIB")
    (setq test nil)
    ) ;_ end of if
  (setq OPList (assoc key ZEList))
  (if (/= OPList nil)
    (setq NPList (cons key col)
          ZEList (subst NPList OPList ZEList)
          ) ;_ end of setq
    (setq ZEList
          (append (reverse (member (assoc 8 ZEList) (reverse zelist)))
                  (cons (cons key col)
                        (cdr (member (assoc 8 ZEList) zelist))
                        ) ;_ end of cons
                  ) ;_ end of append
          ) ;_ end of setq
    ) ;_ end of if
  (entmod ZEList)
  ZELIST
  ) ;_ end of defun

;|«Visual LISP© Format Options»
(72 2 40 1 T "end of " 60 9 0 0 0 nil T nil T)
;*** KEINEN Text unterhalb des Kommentars hinzufügen! ***|;

kann mit jemand weiterhelfen?

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

---

Hi,
Schieb die Zeile (setq ss1 (ssget)) nach oben,
vor (setq MD_...)
sollte dann gehen...
Diese Einstellungen sollten vor der Auswahl gesetzt sein:
(setvar "cmdecho" 0)
  (setvar "tilemode" 1)
  (command "_.-Layer" "_unlock" "*" "")
...
...hab es aber nicht getestet

mfg heiko

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

---

danke für die antwort. funktioniert leider trotzdem nicht.

hat jemand eine andere idee?

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

---

meine Idee

aber speziell zu deinem Problem:
guck dir auch mal folgenden Konstrukt und die Optionen für SSGET an:

(or(and(=(getvar "PICKFIRST")1)
       (setq AUSWAHL(ssget "_i"))
   )
   (setq AUSWAHL (ssget))
)

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

---

Hi,
benutze statt (ssget) (ssgetfirst):

Code:

---

(or (setq aws (cadr (ssgetfirst))) (setq aws (ssget)))

---

und schieb es vor alle command-Befehle.
Grüsse, Henning

------------------
VoxelManufaktur Computer-Dienstleistungen für Architekten und Ingenieure

      http://www.voxelman.de

[Diese Nachricht wurde von wronzky am 06. Nov. 2007 editiert.]

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

---

@wronzky
funktioniert leider auch nicht oder ich mache etwas falsch.

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

---

Hallo,
ich habe CADmiums Variante eingebaut, ersetze den ersten Teil des Programms mit folgenden Code:

Code:

---

(defun C:einfarb (/        SS1      SS1Len  i        NumChg  EName
                  Elist    EType    ZNACZNIK MD_ERR  M:FEHLER m:farbe
                  )
  (setq MD_ERR  *ERROR*
        *ERROR* M:FEHLER
        )
  (and(=(getvar "PICKFIRST")1)
      (setq SS1(ssget "_I"))
  )
  ;_ end of setq
  ;;Marke für Zurück nach Abbruch setzen
  (command "_.UNDO" "_MARK")
  (setvar "cmdecho" 0)
  (setvar "tilemode" 1)
  (command "_.-Layer" "_unlock" "*" "")
 
  (or SS1
  (progn
  (prompt
    "\nElemente wählen zum ändern, oder Return für alle... "
    ) ;_ end of prompt
  (setq SS1 (ssget))))

---

vor die Zeilen
(if
  (null SS1)

Anmerkung: das
(and(=(getvar "PICKFIRST")1)
      (setq SS1(ssget "_I"))
habe ich zum Anfang gesetzt, weil die darauf folgenden Command-Aufrufe die Auswahl "vor Programmablauf" zrücksetzen.

------------------
viele Grüße

Jörn

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

---

danke für die arbeit, aber leider funktioniert es noch immer nicht.
er fragt mich trotzdem nach einer auswahl.

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

---

Hi,
ich komm' noch mal auf meinen Vorschlag zurück, obwohl der von Jörn genausogut funktioniert! (Hast Du es auch exakt so gemacht, wie Jörn es geschrieben hat?)

Code:

---

(defun C:einfarb (/        SS1      SS1Len  i        NumChg  EName
                  Elist    EType    ZNACZNIK MD_ERR  M:FEHLER m:farbe
                  )
  (setq MD_ERR  *ERROR*
        *ERROR* M:FEHLER
        ) ;_ end of setq
  ;;Marke für Zurück nach Abbruch setzen
  (setq SS1 (cadr (ssgetfirst)))
  (command "_.UNDO" "_MARK")
  (setvar "cmdecho" 0)
  (setvar "tilemode" 1)
  (command "_.-Layer" "_unlock" "*" "")
  (if
    (null SS1)
    (or
      (progn
        (prompt "\nElemente wählen zum ändern, oder Return für alle... ") ;_ end of prompt
        (setq SS1 (ssget))
      )
      (setq  SS1 (ssget "X" '((-4 . "<NOT") (0 . "VIEWPORT") (-4 . "NOT>"))))
      )
    )
  (if ss1.......

---

UND PICKFIRST muss 1 sein!

Grüsse, Henning

------------------
VoxelManufaktur Computer-Dienstleistungen für Architekten und Ingenieure

      http://www.voxelman.de

[Diese Nachricht wurde von wronzky am 08. Nov. 2007 editiert.]

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

---

ok danke funktioniert.

war mein fehler. wenn ich das lisp start, kommt trotzdem die abfrage "Objekt wählen". es funktioniert aber, einfach rechtsklick und fertig.

das habe ich falsch verstanden.

danke für die mühe.

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

---

Das liegt daran, das 2x eine Objektabfrage eingebaut ist:
1. Objekte wählen, die eingefärbt werden sollen,
2. Objekt wählen, das die Farbe liefert.
Wenn Du unter 2. kein Objekt wählst, kommt der Farbwahldialog.

Grüsse, Henning

------------------
VoxelManufaktur Computer-Dienstleistungen für Architekten und Ingenieure

  http://www.voxelman.de

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