;;  Programm:      ACM-FARBDREHEN.LSP
;;  Befehlsaufruf: ACM-FARBDREHEN
;;  Funktion:      Objekte per Farbfilter drehen
;;  Autor:         Gerhard Rampf
;;                 Kundenspezifische Anpassungen für AutoCAD und ZWCAD
;;                 Liebigstr. 3 A
;;                 86399 Bobingen
;;                 E-Mail: rampf@geracad.de
;;  Datum:         19.02.2026
;;  Plattform:     Alle AutoCAD-Versionen ab Version 2005 sowie ZWCAD
(defun c:acm-farbdrehen ( / fdr58 fdr59 fdr60 fdr61 fdr62 fdr63 fdr64 fdr65 frd01 frd02 frd03 frd04 frd05 frd06 frd07 frd08 frd09 frd10 frd11 frd12 frd13 frd14 frd15 frd16 frd17)
(defun frd02 (fdr02 fdr03 / )
(vl-catch-all-apply 'setvar (list fdr02 fdr03)))
(defun frd03 ( / fdr17 fdr16 fdr18)
(setq fdr15 (list "align"))
(setq fdr16 (strcase (getvar "CMDNAMES")))
(setq fdr17 0)
(while
(and
fdr15
(/= fdr17 1))
(if (= (strcase (car fdr15)) fdr16)
(progn
(setq fdr18 "")
(setq fdr17 1))
(setq fdr18 fdr16))
(setq fdr15 (cdr fdr15)))
fdr18)
(defun frd04 (fdr04 / )
(if fdr60
(setq *error* fdr60)
(setq *error* nil))
(vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
(if fdr61
(progn
(if command-s
(command-s "._undo" "1")
(command "._undo" "1"))))
(if fdr58
(vl-catch-all-apply 'setvar (list "CMDECHO" fdr58)))
(princ))
(defun frd01 (fdr01 / )
(command "._rotate")
(frd02 "CMDECHO" 1)
(command fdr01 "")
(while (/= (frd03) "")
(command pause))
(frd02 "CMDECHO" 0)
(repeat 5
(command nil))
(setq fdr01 nil))
(defun frd05 ( / fdr19)
(setq fdr19 (strcase (getvar "PRODUCT")))
(if
(or
(and
(= fdr19 "AUTOCAD")
(getvar "HPDRAWORDER"))
(= fdr19 "ZWCAD"))
(setq fdr20 T)
(setq fdr20 nil))
(if (not fdr20)
(alert "\042acm-owahl\042 kann nur unter AutoCAD ab Version 2005 sowie ZWCAD verwendet werden."))
fdr20)
(defun frd06 (fdr05 / fdr21 fdr22 fdr23 fdr24)
(if (> (length fdr05) 2)
(progn
(if (setq fdr21 (vl-string-search "$" (setq fdr22 (cdr (nth 2 fdr05)))))
(setq fdr23 (substr fdr22 (+ fdr21 2)))
(setq fdr23 fdr22)))
(progn
(if (> (length fdr05) 1)
(setq fdr23 (frd07 (cdr (nth 1 fdr05))))
(progn
(setq fdr22 (cdr (nth 0 fdr05)))
(setq fdr24 (car (nth 0 fdr05)))
(if
(and
(= fdr24 62)
(= fdr22 0))
(setq fdr23 "VonBlock"))
(if
(and
(= fdr24 62)
(= fdr22 256))
(setq fdr23 "VonLayer"))
(if
(or
(and
(= fdr24 62)
(> fdr22 256))
(= fdr24 0))
(setq fdr23 "Kein"))
(if
(and
(= fdr24 62)
(and
(> fdr22 0)
(< fdr22 8)))
(setq fdr23 (nth (1- fdr22) '("Rot" "Gelb" "Grün" "Cyan" "Blau" "Magenta" "Weiß"))))
(if
(and
(= fdr24 62)
(and
(> fdr22 7)
(< fdr22 256)))
(setq fdr23 (strcat "Farbe " (itoa fdr22))))))))
fdr23)
(defun frd07 (fdr06 / )
(setq fdr25 (frd08 fdr06))
(strcat
(itoa (car fdr25))
"\054"
(itoa (cadr fdr25))
"\054"
(itoa (caddr fdr25))))
(defun frd08 (fdr06 / )
(list
(lsh (fix fdr06) -16)
(lsh (lsh (fix fdr06) 16) -24)
(lsh (lsh (fix fdr06) 24) -24)))
(defun frd09 ( / fdr26 fdr27)
(setq fdr26 0)
(while (tblsearch "LAYER" (setq fdr27 (strcat "a" (itoa fdr26))))
(setq fdr26 (1+ fdr26)))
fdr27)
(defun frd10 ( / )
(if (not (vl-position me55has$$kal27a (list "0" "1")))
(setq me55has$$kal27a "0"))
(if (not (vl-position me55has$$kal27b (list "0" "1")))
(setq me55has$$kal27b "0"))
(if (not (vl-position me55has$$kal27c (list 0 1 2)))
(setq me55has$$kal27c 0))
(if (not (vl-position me55has$$kal27d (list "0" "1")))
(setq me55has$$kal27d "0"))
(prompt
(strcat
"\nAktuelle Einstellungen: Verschachtelte Quellobjekte wählbar = "
(nth (atoi me55has$$kal27a) (list "Nein" "Ja"))
", VonLayer ersetzen = "
(nth (atoi me55has$$kal27b) (list "Nein" "Ja"))
", Filtermethode = "
(nth me55has$$kal27c (list "Nach Objektfarbe" "Nach Layerfarbe" "Nach Objekt- und Layerfarbe"))
", Filter invertieren = "
(nth (atoi me55has$$kal27d) (list "Nein" "Ja")))))
(defun frd11 (fdr07 / fdr32 fdr33 fdr34)
(if
(and
(setq fdr32 (vl-filename-mktemp "acm.dcl"))
(setq fdr33 (open fdr32 "w")))
(progn
(while fdr07
(if (setq fdr34 (car fdr07))
(write-line fdr34 fdr33))
(setq fdr07 (cdr fdr07)))
(setq fdr33 (close fdr33))
fdr32)
nil))
(defun frd12 (fdr08 / fdr35 fdr36)
(setq fdr35 (getvar "ERRNO"))
(setvar "ERRNO" 7)
(while
(or
(= (getvar "ERRNO") 7)
(= fdr36 "Einstellungen"))
(if (= fdr36 "Einstellungen")
(progn
(frd16)
(setq fdr36 nil)
(setvar "ERRNO" 7))
(progn
(setq fdr36 nil)
(setvar "ERRNO" 0)
(if (= fdr08 0)
(progn
(initget "Einstellungen")
(setq fdr36 (entsel "\nFilterfarbe durch Objekt wählen oder [Einstellungen]: ")))
(progn
(initget "Einstellungen")
(setq fdr36 (nentsel "\nFilterfarbe durch Objekt wählen oder [Einstellungen]: "))))
(if (= (getvar "ERRNO") 7)
(princ "0 gefunden")))))
(if fdr35
(setvar "ERRNO" fdr35))
(if fdr36
(car fdr36)))
(defun frd13 (fdr09 fdr10 / fdr37 fdr38 fdr39 fdr40 fdr41)
(setq fdr37 (entget fdr09))
(if
(or
(= fdr10 0)
(and
(assoc 62 fdr37)
(/= (cdr (assoc 62 fdr37)) 256)))
(progn
(setq fdr38 (assoc 430 fdr37))
(setq fdr39 (assoc 420 fdr37))
(setq fdr40 (assoc 62 fdr37))
(if fdr38
(setq fdr41 (list fdr40 fdr39 (cons 430 (strcase (cdr fdr38)))))
(progn
(if
(and
fdr39
(not fdr38))
(setq fdr41 (list fdr40 fdr39))
(progn
(if
(and
fdr40
(not fdr39))
(setq fdr41 (list fdr40))
(setq fdr41 (list (cons 62 256)))))))))
(setq fdr41 (frd14 (cdr (assoc 8 fdr37)))))
fdr41)
(defun frd14 (fdr11 / fdr42 fdr43)
(if (tblobjname "LAYER" fdr11)
(progn
(setq fdr42 (entget (tblobjname "LAYER" fdr11)))
(if
(and
(assoc 420 fdr42)
(assoc 430 fdr42))
(setq fdr43 (list (cons 62 (abs (cdr (assoc 62 fdr42)))) (assoc 420 fdr42) (cons 430 (strcase (cdr (assoc 430 fdr42)))))))
(if
(and
(assoc 420 fdr42)
(not (assoc 430 fdr42)))
(setq fdr43 (list (cons 62 (abs (cdr (assoc 62 fdr42)))) (assoc 420 fdr42))))
(if
(and
(not (assoc 420 fdr42))
(not (assoc 430 fdr42)))
(setq fdr43 (list (cons 62 (abs (cdr (assoc 62 fdr42)))))))
fdr43)
nil))
(defun frd15 (fdr12 / fdr44 fdr45 fdr46 fdr47 fdr48)
(setq fdr44 (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))))
(vlax-for item fdr44
(setq fdr45 (cons (vla-get-Name item) fdr45)))
(while fdr45
(setq fdr46 (frd14 (setq fdr47 (car fdr45))))
(if (equal fdr46 fdr12)
(setq fdr48 (cons fdr47 fdr48)))
(setq fdr45 (cdr fdr45)))
fdr48)
(defun frd16 ( / fdr49 fdr50 fdr51 fdr52)
(setq fdr49
(list
"acm219"
":dialog{label=\042Einstellungen\042;"
":spacer{height=0.2;}"
":toggle{key=\042tg_01\042;label=\042Verschachtelte Quellobjekte &wählbar\042;}"
":toggle{key=\042tg_03\042;label=\042V&onLayer durch Layerfarbe ersetzen\042;}"
":spacer{height=0;}"
":boxed_column{label=\042Filtern nach\042;"
":radio_button{key=\042rb_01\042;label=\042O&bjektfarbe\042;}"
":radio_button{key=\042rb_02\042;label=\042&Layerfarbe\042;}"
":radio_button{key=\042rb_03\042;label=\042Objekt- &und Layerfarbe\042;}"
":spacer{height=0.1;}"
":toggle{key=\042tg_02\042;label=\042&Filter invertieren\042;}}"
":spacer{height=0.4;}"
":row{"
":spacer{width=4;}"
":column{width=20;fixed_width=true;"
":button{key=\042b_01\042;label=\042OK\042;is_default=true;}"
":button{key=\042b_02\042;label=\042Abbrechen\042;is_cancel=true;}}"
":spacer{width=4;}}}"))
(if (setq fdr50 (frd11 fdr49))
(progn
(setq fdr51 (load_dialog fdr50))
(vl-catch-all-apply 'vl-file-delete (list fdr50))
(if (not (new_dialog "acm219" fdr51))
(exit))
(set_tile "tg_01" me55has$$kal27a)
(set_tile "tg_03" me55has$$kal27b)
(if (= me55has$$kal27c 0)
(set_tile "rb_01" "1")
(progn
(if (= me55has$$kal27c 1)
(set_tile "rb_02" "1")
(set_tile "rb_03" "1"))))
(set_tile "tg_02" me55has$$kal27d)
(action_tile "b_01" "(if (= (get_tile \"rb_01\") \"1\") (setq me55has$$kal27c 0)) (if (= (get_tile \"rb_02\") \"1\") (setq me55has$$kal27c 1)) (if (= (get_tile \"rb_03\") \"1\") (setq me55has$$kal27c 2)) (setq fdr52 (list (setq me55has$$kal27a (get_tile \"tg_01\")) me55has$$kal27c (setq me55has$$kal27d (get_tile \"tg_02\")) (setq me55has$$kal27b (get_tile \"tg_03\")))) (done_dialog) (frd10)")
(action_tile "b_02" "(setq fdr52 nil) (done_dialog)")
(start_dialog)
(unload_dialog fdr51)))
fdr52)
(defun frd17 (fdr13 fdr10 fdr14 / fdr45 fdr53 fdr54 fdr55 fdr56 fdr57)
(if (vl-position fdr10 (list 1 2))
(progn
(if (setq fdr45 (frd15 fdr13))
(progn
(setq fdr53 (list (cons -4 "or>") (cons -4 "and>")))
(while fdr45
(setq fdr53 (cons (cons 8 (car fdr45)) fdr53))
(setq fdr45 (cdr fdr45)))
(setq fdr53 (cons (cons -4 "<or") fdr53))
(setq fdr53 (cons (cons 62 256) fdr53))
(setq fdr53 (cons (cons -4 "<and") fdr53)))
(progn
(setq fdr54 (frd09))
(setq fdr53 (list (cons -4 "<and") (cons 8 fdr54) (cons 62 256) (cons -4 "and>")))))))
(if (vl-position fdr10 (list 0 2))
(progn
(if (= (length fdr13) 3)
(setq fdr55 (list (cons -4 "<and") (car fdr13) (cadr fdr13) (caddr fdr13) (cons -4 "and>")))
(progn
(if (= (length fdr13) 2)
(setq fdr55 (list (cons -4 "<and") (cadr fdr13) (cons 430 "") (cons -4 "and>")))
(setq fdr55 (list (cons -4 "<and") (car fdr13) (cons -4 "<not") (cons -4 "*") (cons 420 0) (cons -4 "not>") (cons -4 "and>"))))))))
(if (= fdr10 0)
(setq fdr56 fdr55))
(if (= fdr10 1)
(setq fdr56 fdr53))
(if (= fdr10 2)
(progn
(if fdr53
(progn
(setq fdr57 (list (cons -4 "<or")))
(setq fdr57 (append fdr57 fdr55))
(setq fdr57 (append fdr57 fdr53))
(setq fdr57 (append fdr57 (list (cons -4 "or>"))))
(setq fdr56 fdr57))
(setq fdr56 fdr55))))
(if (= fdr14 1)
(progn
(setq fdr56 (append (reverse fdr56) (list (cons -4 "<not"))))
(setq fdr56 (append (reverse fdr56) (list (cons -4 "not>"))))))
fdr56)
(if (frd05)
(progn
(vl-load-com)
(setq fdr58 (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq fdr59 (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq fdr60 *error*)
(setq *error* frd04)
(vla-EndUndoMark fdr59)
(vla-StartUndoMark fdr59)
(setq fdr61 T)
(if (ssget "_i")
(sssetfirst nil nil))
(frd10)
(if (setq fdr62 (frd12 (atoi me55has$$kal27a)))
(progn
(setq fdr63 (frd13 fdr62 (atoi me55has$$kal27b)))
(prompt (strcat "\nGewählte Filterfarbe = " (frd06 fdr63) " "))
(prompt "\nZu drehende Objekte wählen ... ")
(setq fdr64 (frd17 fdr63 me55has$$kal27c (atoi me55has$$kal27d)))
(if (setq fdr65 (ssget "_:L" fdr64))
(vl-catch-all-apply 'frd01 (list fdr65)))))
(if fdr60
(setq *error* fdr60)
(setq *error* nil))
(setvar "CMDECHO" fdr58)
(vla-EndUndoMark fdr59)))
(princ))
(terpri)
(princ (strcat "\nAutoLISP-Tool ACM-FARBDREHEN (Copyright © " (substr (rtos (getvar "CDATE")) 1 4) " Gerhard Rampf) geladen. "))
(princ "\nRufen Sie den Befehl mit ACM-FARBDREHEN auf.")
