;;;   Programm:      ACM-LAYDREHEN.LSP
;;;   Befehlsaufruf: ACM-LAYDREHEN
;;;   Funktion:      Mittels per Quellobjektwahl, Auswahlliste oder Option "Vorherige
;;;                  Auswahl" erstelltem Layerfilter gewählte Objekte drehen.
;;;   Autor:         Gerhard Rampf
;;;                  Kundenspezifische Anpassungen für AutoCAD und ZWCAD
;;;                  Liebigstr. 3 A
;;;                  86399 Bobingen
;;;                  E-Mail: rampf@geracad.de
;;;   Datum:         23.10.2025
;;;   Plattform:     Alle AutoCAD-Versionen ab Version 2005
(defun c:acm-laydrehen ( / ldr85 ldr86 lrd01 lrd02 lrd03 lrd04 lrd05 lrd06 lrd07 lrd08 lrd09 lrd10 lrd11 lrd12 lrd13 lrd14 lrd15 lrd16 lrd17 lrd18 lrd19 lrd20 lrd21)
(defun lrd01 ( / ldr19 ldr20 ldr21 ldr22)
(setq ldr19 (cdr (assoc 8 kwucz62$-_jk87&a)))
(setq ldr20 (lrd10 ldr19 ","))
(while ldr20
(setq ldr21 (car ldr20))
(setq ldr22 (cons ldr21 ldr22))
(setq ldr20 (cdr ldr20)))
(if ldr22
(progn
(setq ldr22 (acad_strlsort ldr22))
(prompt "\n ")
(prompt (strcat "\n" (itoa (length ldr22)) " Filterlayer gewählt: "))
(while ldr22
(prompt (strcat "\n" (car ldr22) " "))
(setq ldr22 (cdr ldr22)))
(prompt "\n "))))
(defun lrd02 (ldr01 / )
(command "._rotate")
(lrd04 "CMDECHO" 1)
(command ldr01 "")
(while (/= (lrd03) "")
(command pause))
(lrd04 "CMDECHO" 0)
(repeat 5
(command nil))
(setq ldr01 nil))
(defun lrd03 ( / ldr25 ldr24 ldr26)
(setq ldr23 (list "align"))
(setq ldr24 (strcase (getvar "CMDNAMES")))
(setq ldr25 0)
(while
(and
ldr23
(/= ldr25 1))
(if (= (strcase (car ldr23)) ldr24)
(progn
(setq ldr26 "")
(setq ldr25 1))
(setq ldr26 ldr24))
(setq ldr23 (cdr ldr23)))
ldr26)
(defun lrd04 (ldr02 ldr03 / )
(vl-catch-all-apply 'setvar (list ldr02 ldr03)))
(defun lrd05 (ldr04 ldr05 / ldr27 ldr28 ldr29 ldr30 ldr32 ldr31)
(if (= ldr05 "")
(progn
(alert "Keine Eingabe für \042Suchen nach\042.")
(mode_tile "eb_01" 2))
(progn
(setq ldr27 (mapcar 'strcase ldr04))
(setq ldr28 (strcase ldr05))
(setq ldr29 "")
(setq ldr30 -1)
(setq ldr31 0)
(repeat (length ldr27)
(setq ldr30 (1+ ldr30))
(if (wcmatch (nth ldr30 ldr27) ldr28)
(progn
(setq ldr29 (strcat ldr29 (itoa ldr30) " "))
(setq ldr31 (1+ ldr31)))))
(if
(and
(<= ldr31 250)
(/= (setq ldr32 (vl-string-trim " " ldr29)) ""))
(progn
(set_tile "lb_01" "")
(set_tile "lb_01" ldr32)
(mode_tile "b_01" 0))
(progn
(set_tile "lb_01" "0")
(set_tile "lb_01" "")
(if (> ldr31 250)
(alert "Ungültige Auswahl. Mehr als 250 entsprechende Layer gefunden.")
(alert "Es wurden keine entsprechenden Layer gefunden."))
(mode_tile "eb_01" 2)
(mode_tile "b_01" 1))))))
(defun lrd06 ( / ldr33)
(setq ldr33 (strcase (getvar "PRODUCT")))
(if
(and
(= ldr33 "AUTOCAD")
(getvar "HPDRAWORDER"))
(setq ldr34 T)
(setq ldr34 nil))
(if (not ldr34)
(alert "Dieses Tool kann nur unter AutoCAD ab Version 2005 verwendet werden."))
ldr34)
(defun lrd07 (ldr06 / )
(if ldr83 (vl-catch-all-apply 'setvar (list "CMDECHO" ldr83)))
(if ldr86 (setq *error* ldr86))
(vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
(princ))
(defun lrd08 ( / ldr35 ldr46 ldr36 ldr37)
(setq ldr35 (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))))
(vlax-for ldr46 ldr35
(if
(and
(= (vla-get-Lock ldr46) :vlax-false)
(not (vl-string-search "|" (setq ldr36 (vlax-get ldr46 'Name)))))
(setq ldr37 (cons ldr36 ldr37))))
(if ldr37
(acad_strlsort ldr37)
nil))
(defun lrd09 ( / ldr19 ldr20 ldr21 ldr38 ldr39 ldr40)
(if
(and
(lrd08)
(= (type kwucz62$-_jk87&a) 'LIST)
(setq ldr19 (cdr (assoc 8 kwucz62$-_jk87&a))))
(progn
(setq ldr35 (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))))
(setq ldr20 (lrd10 ldr19 ","))
(while ldr20
(if (tblsearch "LAYER" (setq ldr21 (car ldr20)))
(setq ldr38 (cons ldr21 ldr38)))
(setq ldr20 (cdr ldr20)))
(if ldr38
(setq ldr39 (acad_strlsort ldr38))
(setq ldr39 nil)))
(setq ldr39 nil))
(if ldr39
(progn
(setq ldr40 "")
(while ldr39
(setq ldr21 (car ldr39))
(setq ldr40 (strcat ldr40 ldr21 ","))
(setq ldr39 (cdr ldr39)))
(setq ldr40 (lrd16 ldr40 1))
(setq kwucz62$-_jk87&a (list (cons 8 ldr40))))
(setq kwucz62$-_jk87&a nil)))
(defun lrd10 (ldr07 ldr08 / ldr42 ldr43)
(if
(and
(= (type ldr07) 'STR)
(= (type ldr08) 'STR))
(progn
(setq ldr07 (vl-string-trim ldr08 ldr07))
(setq ldr07 (vl-string-trim " " ldr07))
(while (setq ldr42 (vl-string-search ldr08 ldr07))
(setq ldr43 (append ldr43 (list (substr ldr07 1 ldr42))))
(setq ldr07 (vl-string-left-trim ldr08 (substr ldr07 (1+ ldr42)))))
(setq ldr43 (append ldr43 (list ldr07)))))
ldr43)
(defun lrd11 (ldr09 ldr10 / ldr44 ldr45 ldr46 ldr42)
(setq ldr44 (strlen ldr09))
(setq ldr45 1)
(while (<= ldr45 ldr44)
(setq ldr46 (substr ldr09 ldr45 1))
(if (/= ldr46 ldr10)
(progn
(setq ldr42 nil)
(setq ldr45 (1+ ldr45))))
(if (= ldr46 ldr10)
(progn
(setq ldr42 ldr45)
(setq ldr45 (1+ ldr44)))))
ldr42)
(defun lrd12 (ldr09 ldr11 / ldr44 ldr46 ldr30 ldr47)
(setq ldr44 (strlen ldr09))
(setq ldr46 (substr ldr09 1 1))
(setq ldr30 0)
(while
(and
(/= (member ldr46 ldr11) nil)
(/= ldr30 ldr44))
(setq ldr09 (substr ldr09 2))
(setq ldr46 (substr ldr09 1 1))
(setq ldr30 (+ ldr30 1)))
(if (/= ldr30 ldr44)
(progn
(setq ldr44 (strlen ldr09))
(setq ldr47 (substr ldr09 ldr44 1))
(setq ldr30 ldr44)
(while
(and
(/= (member ldr47 ldr11) nil)
(/= ldr30 0))
(setq ldr09 (substr ldr09 1 ldr30))
(setq ldr47 (substr ldr09 ldr30 1))
(setq ldr30 (- ldr30 1)))))
ldr09)
(defun lrd13 (ldr12 ldr13 / ldr48 ldr42 ldr49 ldr34)
(if
(and
(= (type ldr12) 'STR)
(= (type ldr13) 'STR))
(progn
(setq ldr48 (lrd12 ldr12 (list ldr13)))
(setq ldr42 (lrd11 ldr48 ldr13))
(if ldr42
(progn
(setq ldr49 (substr ldr48 1 (1- ldr42)))
(setq ldr48 (lrd12 (substr ldr48 (1+ (strlen ldr49))) (list ldr13)))
(setq ldr34 (cons ldr49 ldr34))))
(setq ldr42 (lrd11 ldr48 ldr13))
(while ldr42
(setq ldr49 (substr ldr48 1 (1- ldr42)))
(setq ldr48 (lrd12 (substr ldr48 (1+ (strlen ldr49))) (list ldr13)))
(setq ldr34 (cons ldr49 ldr34))
(setq ldr42 (lrd11 ldr48 ldr13)))
(if (> (strlen ldr48) 0)
(setq ldr34 (cons ldr48 ldr34)))))
(if ldr34
(reverse ldr34)
nil))
(defun lrd14 ( / ldr50 ldr51 ldr52)
(prompt "\nFilterlayer per Quellobjektewahl bestimmen ... ")
(if (setq ldr50 (ssget))
(progn
(setq ldr51 (lrd19 ldr50))
(setq ldr52 (lrd15 ldr51))
(setq kwucz62$-_jk87&a ldr52))
(setq ldr52 nil))
(if ldr52
(list 1 ldr52)
(progn
(prompt "\nKeine Filterlayer gewählt. ")
nil)))
(defun lrd15 (ldr14 / ldr53 ldr40 ldr46)
(setq ldr53 ldr14)
(setq ldr40 "")
(while ldr53
(setq ldr46 (car ldr53))
(setq ldr40 (strcat ldr40 ldr46 ","))
(setq ldr53 (cdr ldr53)))
(setq ldr40 (lrd16 ldr40 1))
(if (/= ldr40 "")
(list (cons 8 ldr40))
nil))
(defun lrd16 (ldr15 ldr16 / ldr44 ldr54)
(setq ldr44 (strlen ldr15))
(if (> ldr16 ldr44)
(setq ldr16 ldr44))
(setq ldr54 (- ldr44 ldr16))
(setq ldr15 (substr ldr15 1 ldr54)))
(defun lrd17 (ldr17 / ldr55 ldr56 ldr19 ldr57 ldr58 ldr42 ldr59 ldr60 ldr40 ldr61 ldr62 ldr63 ldr64 ldr65 ldr34)
(if (setq ldr55 (lrd18))
(progn
(setq ldr56 (load_dialog ldr55))
(if (not (new_dialog "acm624lo" ldr56))
(exit))
(vl-catch-all-apply 'vl-file-delete (list ldr55))
(start_list "lb_01")
(mapcar 'add_list ldr17)
(end_list)
(if
(and
(= (type kwucz62$-_jk87&a) 'LIST)
(setq ldr19 (cdr (assoc 8 kwucz62$-_jk87&a))))
(progn
(setq ldr57 (lrd10 ldr19 ","))
(setq ldr57 (mapcar 'strcase ldr57))
(setq ldr58 (mapcar 'strcase ldr17))
(while ldr57
(if (setq ldr42 (vl-position (car ldr57) ldr58))
(setq ldr59 (cons ldr42 ldr59)))
(setq ldr57 (cdr ldr57)))
(if ldr59
(progn
(setq ldr60 (vl-sort ldr59 '<))
(setq ldr40 "")
(while ldr60
(setq ldr40 (strcat ldr40 (itoa (car ldr60)) " "))
(setq ldr60 (cdr ldr60)))
(setq ldr61 (lrd16 ldr40 1)))
(setq ldr61 nil)))
(setq ldr61 nil))
(if ldr61
(set_tile "lb_01" ldr61))
(if (= (get_tile "lb_01") "")
(mode_tile "b_01" 1))
(set_tile "t_01" (strcat (itoa (length (lrd13 (get_tile "lb_01") " "))) " Layer gewählt"))
(action_tile "lb_01" "(if (> (length (lrd13 $value \" \")) 250)
(progn
(alert \"Ungültige Auswahl. Bitte maximal 250 Einträge wählen.\")
(set_tile $key \"0\")
(set_tile $key \"\")
(mode_tile \"b_01\" 1))
(progn
(if (= (get_tile \"lb_01\") \"\")
(mode_tile \"b_01\" 1)
(mode_tile \"b_01\" 0))))
(set_tile \"t_01\" (strcat (itoa (length (lrd13 (get_tile \"lb_01\") \" \"))) \" Layer gewählt\"))")
(action_tile "b_00" "(set_tile \"eb_01\" (setq ldr62 (vl-string-trim \" \" (get_tile \"eb_01\"))))
(lrd05 ldr17 ldr62)
(set_tile \"t_01\" (strcat (itoa (length (lrd13 (get_tile \"lb_01\") \" \"))) \" Layer gewählt\"))")
(action_tile "eb_01" "(if (= $reason 1)
(progn
(set_tile $key (setq ldr63 (vl-string-trim \" \" $value)))
(lrd05 ldr17 ldr63)
(set_tile \"t_01\" (strcat (itoa (length (lrd13 (get_tile \"lb_01\") \" \"))) \" Layer gewählt\")))
)")
(action_tile "b_01" "(setq ldr64 (lrd13 (setq ldr65 (get_tile \"lb_01\")) \" \"))
(setq ldr64 (mapcar 'atoi ldr64))
(while ldr64
(setq ldr34 (cons (nth (car ldr64) ldr17) ldr34))
(setq ldr64 (cdr ldr64)))
(setq ldr34 (list 1 (setq kwucz62$-_jk87&a (lrd15 (reverse ldr34)))))
(done_dialog)")
(action_tile "b_02" "(setq ldr34 nil) (done_dialog)")
(start_dialog)
(unload_dialog ldr56)))
ldr34)
(defun lrd18 ( / ldr66 ldr67 ldr68)
(if
(and
(setq ldr66 (vl-filename-mktemp "acm.dcl"))
(setq ldr67 (open ldr66 "w")))
(progn
(setq ldr68
(list
"acm624lo"
":dialog{label=\042Filterlayer wählen\042;"
":spacer{height=0.4;}"
":list_box{key=\042lb_01\042;width=35;height=15;multiple_select=true;}"
":text{key=\042t_01\042;}"
":spacer{height=0;}"
":row{"
":button{key=\042b_00\042;label=\042&Suchen nach:\042;width=0;fixed_width=true;}"
":edit_box{key=\042eb_01\042;width=20;}}"
":spacer{height=0.4;}"
":row{"
":spacer{width=5;}"
":column{width=20;"
":button{key=\042b_01\042;label=\042OK\042;is_default=true;}"
":button{key=\042b_02\042;label=\042Abbrechen\042;is_cancel=true;}}"
":spacer{width=5;}}}"))
(while ldr68
(write-line (car ldr68) ldr67)
(setq ldr68 (cdr ldr68)))
(setq ldr67 (close ldr67))
ldr66)
nil))
(defun lrd19 (ldr18 / ldr69 ldr70 ldr71 ldr72 ldr73 ldr74 ldr20)
(setq ldr69 (sslength ldr18))
(setq ldr70 -1)
(setq ldr71 0)
(repeat ldr69
(setq ldr70 (1+ ldr70))
(setq ldr72 (ssname ldr18 ldr70))
(setq ldr73 (vlax-ename->vla-object ldr72))
(setq ldr74 (vlax-get ldr73 'Layer))
(if (not (vl-position ldr74 ldr20))
(setq ldr20 (cons ldr74 ldr20))))
ldr20)
(defun lrd20 ( / ldr76 ldr77 ldr78)
(if (not (vl-position kwucz62$-_jk87&b (list 0 1 2 3)))
(setq kwucz62$-_jk87&b 0))
(if (= (type kwucz62$-_jk87&a) 'LIST)
(progn
(setq ldr76 "Objektwahl Vorherige auSwahlliste")
(if (= kwucz62$-_jk87&b 0)
(setq ldr77 "\nFilterlayer wählen durch [Objektwahl/Vorherige auswahl/auSwahlliste] <Objektwahl>: "))
(if (= kwucz62$-_jk87&b 1)
(setq ldr77 "\nFilterlayer wählen durch [Objektwahl/Vorherige auswahl/auSwahlliste] <Vorherige auswahl>: "))
(if (= kwucz62$-_jk87&b 2)
(setq ldr77 "\nFilterlayer wählen durch [Objektwahl/Vorherige auswahl/auSwahlliste] <auSwahlliste>: ")))
(progn
(if (not (vl-position kwucz62$-_jk87&b (list 0 2 3)))
(setq kwucz62$-_jk87&b 0))
(setq ldr76 "Objektwahl auSwahlliste")
(if (= kwucz62$-_jk87&b 0)
(setq ldr77 "\nFilterlayer wählen durch [Objektwahl/auSwahlliste] <Objektwahl>: "))
(if (= kwucz62$-_jk87&b 2)
(setq ldr77 "\nFilterlayer wählen durch [Objektwahl/auSwahlliste] <auSwahlliste>: "))))
(initget ldr76)
(if (setq ldr78 (getkword ldr77))
(setq kwucz62$-_jk87&b (nth (vl-position ldr78 (list "Objektwahl" "Vorherige" "auSwahlliste")) (list 0 1 2))))
kwucz62$-_jk87&b)
(defun lrd21 ( / ldr83 ldr79 ldr80 ldr81 ldr82 ldr20 ldr35)
(if (setq ldr79 (lrd08))
(progn
(lrd09)
(setq ldr80 (lrd20))
(if (= ldr80 0)
(setq ldr81 (lrd14)))
(if (= ldr80 1)
(setq ldr81 (list 1 kwucz62$-_jk87&a)))
(if (= ldr80 2)
(setq ldr81 (lrd17 ldr79)))
(if (vl-position ldr80 (list 0 1 2))
(progn
(if ldr81
(progn
(setq kwucz62$-_jk87&a (cadr ldr81))
(setq ldr82 (cdr (assoc 8 kwucz62$-_jk87&a)))
(setq ldr83 (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(lrd01)
(prompt "\nZu drehende Objekte wählen ... ")
(if (setq ldr84 (ssget "_:L" kwucz62$-_jk87&a))
(lrd02 ldr84))
(setq ldr20 (lrd10 ldr82 ","))
(setq ldr35 (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))))
(setvar "CMDECHO" ldr83))))))
(alert "Aktuell sind alle verwendbaren Layer gesperrt.")))
(if (lrd06)
(progn
(vl-load-com)
(setq ldr85 (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq ldr86 *error*)
(setq *error* lrd07)
(vla-EndUndoMark ldr85)
(vla-StartUndoMark ldr85)
(lrd21)
(if ldr86
(setq *error* ldr86)
(setq *error* nil))
(vla-EndUndoMark ldr85)))
(princ))
(terpri)
(princ (strcat "\nAutoLISP-Tool ACM-LAYDREHEN (Copyright © " (substr (rtos (getvar "CDATE")) 1 4) " Gerhard Rampf) geladen. "))
(princ "\nRufen Sie den Befehl mit ACM-LAYDREHEN auf.")
