;;  Programm:      ACM-BEMSTILNAMENAENDERN.LSP
;;  Befehlsaufruf: ACM-BEMSTILNAMENAENDERN
;;  Funktion:      Ändert Umlaute, Eszett- und Leerzeichen sowie die Groß-/Kleinscheibung
;;                 von Bemaßungsstilnamen.
;;  Autor:         Gerhard Rampf
;;                 Kundenspezifische Anpassungen für AutoCAD und ZWCAD
;;                 Liebigstr. 3 A
;;                 86399 Bobingen
;;                 E-Mail: rampf@geracad.de
;;  Datum:         17.05.2025
;;  Plattform:     Alle AutoCAD-Versionen ab Version 2010
(defun acb01 (abc01 abc02 / abc14)
(if (= abc02 "0")
(setq abc14 (strcase abc01)))
(if (= abc02 "1")
(setq abc14 (strcase abc01 T)))
(if (= abc02 "2")
(setq abc14 (strcat (strcase (substr abc01 1 1)) (strcase (substr abc01 2) T))))
abc14)
(defun acb02 (abc03 abc04 / abc15 abc16 abc17 abc18)
(setq abc15 (strlen abc03))
(setq abc16 1)
(while (<= abc16 abc15)
(setq abc17 (substr abc03 abc16 1))
(if (/= abc17 abc04)
(progn
(setq abc18 nil)
(setq abc16 (1+ abc16))))
(if (= abc17 abc04)
(progn
(setq abc18 abc16)
(setq abc16 (1+ abc15)))))
abc18)
(defun acb03 (abc05 abc06 / abc19 abc20 abc21 abc22 abc24 abc23)
(if (= abc06 "")
(progn
(alert "Keine Eingabe für \042Suchen nach\042.")
(mode_tile "eb_01" 2))
(progn
(setq abc19 (mapcar 'strcase abc05))
(setq abc20 (strcase abc06))
(setq abc21 "")
(setq abc22 -1)
(setq abc23 0)
(repeat (length abc19)
(setq abc22 (1+ abc22))
(if (wcmatch (nth abc22 abc19) abc20)
(progn
(setq abc21 (strcat abc21 (itoa abc22) " "))
(setq abc23 (1+ abc23)))))
(if
(and
(<= abc23 250)
(/= (setq abc24 (vl-string-trim " " abc21)) ""))
(progn
(set_tile "lb_01" "")
(set_tile "lb_01" abc24)
(mode_tile "b_01" 0))
(progn
(set_tile "lb_01" "0")
(set_tile "lb_01" "")
(if (> abc23 250)
(alert "Ungültige Auswahl. Mehr als 250 entsprechende Bemaßungsstile gefunden.")
(alert "Es wurden keine entsprechenden Bemaßungsstile gefunden."))
(mode_tile "eb_01" 2)
(mode_tile "b_01" 1))))))
(defun acb04 (abc03 abc07 / abc15 abc17 abc22 abc25)
(setq abc15 (strlen abc03))
(setq abc17 (substr abc03 1 1))
(setq abc22 0)
(while
(and
(/= (member abc17 abc07) nil)
(/= abc22 abc15))
(setq abc03 (substr abc03 2))
(setq abc17 (substr abc03 1 1))
(setq abc22 (+ abc22 1)))
(if (/= abc22 abc15)
(progn
(setq abc15 (strlen abc03))
(setq abc25 (substr abc03 abc15 1))
(setq abc22 abc15)
(while
(and
(/= (member abc25 abc07) nil)
(/= abc22 0))
(setq abc03 (substr abc03 1 abc22))
(setq abc25 (substr abc03 abc22 1))
(setq abc22 (- abc22 1)))))
abc03)
(defun acb05 (abc08 abc09 / abc26 abc18 abc27 abc14)
(if
(and
(= (type abc08) 'STR)
(= (type abc09) 'STR))
(progn
(setq abc26 (acb04 abc08 (list abc09)))
(setq abc18 (acb02 abc26 abc09))
(if abc18
(progn
(setq abc27 (substr abc26 1 (1- abc18)))
(setq abc26 (acb04 (substr abc26 (1+ (strlen abc27))) (list abc09)))
(setq abc14 (cons abc27 abc14))))
(setq abc18 (acb02 abc26 abc09))
(while abc18
(setq abc27 (substr abc26 1 (1- abc18)))
(setq abc26 (acb04 (substr abc26 (1+ (strlen abc27))) (list abc09)))
(setq abc14 (cons abc27 abc14))
(setq abc18 (acb02 abc26 abc09)))
(if (> (strlen abc26) 0)
(setq abc14 (cons abc26 abc14)))))
(if abc14
(reverse abc14)
nil))
(defun acb06 ( / abc28 abc29 abc30)
(if
(and
(setq abc28 (vl-filename-mktemp "acm.dcl"))
(setq abc29 (open abc28 "w")))
(progn
(setq abc30
(list
"acm_1b_2023"
":dialog{label=\042Anwenden auf Bemaßungsstile\042;"
":spacer{height=0.4;}"
":list_box{key=\042lb_01\042;width=25;height=9;multiple_select=true;}"
":row{"
":button{key=\042b_00\042;label=\042&Suchen nach:\042;width=0;fixed_width=true;}"
":edit_box{key=\042eb_01\042;width=15;}}"
":spacer{height=0.2;}"
":row{"
":spacer{width=9;}"
":column{width=0;"
":button{key=\042b_01\042;label=\042OK\042;is_default=true;}"
":button{key=\042b_02\042;label=\042Abbrechen\042;is_cancel=true;}}"
":spacer{width=9;}}}"))
(while abc30
(write-line (car abc30) abc29)
(setq abc30 (cdr abc30)))
(setq abc29 (close abc29))
abc28)
nil))
(defun acb07 (abc10 / abc31 abc32 abc33 abc34 abc14 abc36)
(if (setq abc31 (acb06))
(progn
(setq abc32 (load_dialog abc31))
(if (not (new_dialog "acm_1b_2023" abc32))
(exit))
(vl-catch-all-apply 'vl-file-delete (list abc31))
(start_list "lb_01")
(mapcar 'add_list abc10)
(end_list)
(if (= (get_tile "lb_01") "")
(mode_tile "b_01" 1))
(action_tile "lb_01" "(if (> (length (acb05 $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 (= $value \"\") (mode_tile \"b_01\" 1) (mode_tile \"b_01\" 0)))))")
(action_tile "b_00" "(set_tile \"eb_01\" (setq abc33 (vl-string-trim \" \" (get_tile \"eb_01\")))) (acb03 abc10 abc33)")
(action_tile "eb_01" "(if (= $reason 1) (progn (set_tile $key (setq abc34 (vl-string-trim \" \" $value))) (acb03 abc10 abc34)))")
(action_tile "b_01" "(setq abc35 (acb05 (setq abc36 (get_tile \"lb_01\")) \" \")) (setq abc35 (mapcar 'atoi abc35)) (while abc35 (setq abc14 (cons (nth (car abc35) abc10) abc14)) (setq abc35 (cdr abc35))) (setq abc14 (reverse abc14)) (done_dialog)")
(action_tile "b_02" "(setq abc14 nil) (done_dialog)")
(start_dialog)
(unload_dialog abc32)))
abc14)
(defun acb08 ( / abc37)
(setq abc37 (strcase (getvar "PRODUCT")))
(if
(and
(= abc37 "AUTOCAD")
(getvar "HPDRAWORDER"))
(setq abc14 T)
(setq abc14 nil))
(if (not abc14)
(alert "\042acm-stilnamenaendern\042 kann nur unter AutoCAD ab Version 2005 verwendet werden."))
abc14)
(defun acb09 (abc11 / )
(if abc66 (setq *error* abc66))
(vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
(princ))
(defun acb10 (abc01 abc02 / abc38 abc39 abc40 abc41 abc42)
(if (= abc02 0)
(progn
(setq abc38 "ä")
(setq abc39 "ae")))
(if (= abc02 1)
(progn
(setq abc38 "Ä")
(setq abc39 "Ae")))
(if (= abc02 2)
(progn
(setq abc38 "ö")
(setq abc39 "oe")))
(if (= abc02 3)
(progn
(setq abc38 "Ö")
(setq abc39 "Oe")))
(if (= abc02 4)
(progn
(setq abc38 "ü")
(setq abc39 "ue")))
(if (= abc02 5)
(progn
(setq abc38 "Ü")
(setq abc39 "Ue")))
(if (= abc02 6)
(progn
(setq abc38 "ß")
(setq abc39 "ss")))
(if (= abc02 7)
(progn
(setq abc38 " ")
(setq abc39 "")))
(if (= abc02 8)
(progn
(setq abc38 " ")
(setq abc39 "-")))
(if (= abc02 9)
(progn
(setq abc38 " ")
(setq abc39 "_")))
(if (vl-string-search abc38 abc01)
(progn
(while (setq abc40 (vl-string-search abc38 abc01))
(if (> abc40 0)
(progn
(setq abc41 (substr abc01 1 abc40))
(setq abc42 (substr abc01 (+ abc40 2))))
(progn
(setq abc41 "")
(setq abc42 (substr abc01 2))))
(setq abc01 (strcat abc41 abc39 abc42)))))
abc01)
(defun acb11 (abc01 / abc43 abc44)
(setq abc43 abc01)
(setq abc44 -1)
(repeat 6
(setq abc44 (1+ abc44))
(setq abc01 (acb10 abc01 abc44)))
(list abc43 abc01))
(defun acb12 (abc01 abc02 / abc43 abc44)
(setq abc43 abc01)
(setq abc01 (acb10 abc01 abc02))
(list abc43 abc01))
(defun acb13 (abc01 abc02 / abc43 abc44)
(setq abc43 abc01)
(setq abc01 (acb10 abc01 abc02))
(list abc43 abc01))
(defun acb14 ( / abc28 abc29 abc30)
(if
(and
(setq abc28 (vl-filename-mktemp "acm.dcl"))
(setq abc29 (open abc28 "w")))
(progn
(setq abc30
(list
"acm_cln"
":dialog{label=\042Änderungsoptionen\042;"
":spacer{height=0;}"
":boxed_column{label=\042Umlaute\042;"
":toggle{key=\042tg_01\042;label=\042&Ersetzen\042;}}"
":spacer{height=0;}"
":boxed_column{label=\042Eszett\042;"
":toggle{key=\042tg_02\042;label=\042E&rsetzen\042;}}"
":spacer{height=0;}"
":boxed_column{label=\042Leerzeichen\042;"
":toggle{key=\042tg_03\042;label=\042&Bearbeiten\042;}"
":row{"
":spacer{width=1;fixed_width=true;}"
":column{width=33;fixed_width=true;"
":radio_button{key=\042rb_01\042;label=\042E&ntfernen\042;}"
":radio_button{key=\042rb_02\042;label=\042Er&setzen durch Bindestrich\042;}"
":radio_button{key=\042rb_03\042;label=\042Ersetzen &durch Unterstrich\042;}}}}"
":spacer{height=0;}"
":boxed_column{label=\042Groß-/Kleinschreibung\042;"
":toggle{key=\042tg_04\042;label=\042Ändern &in\042;}"
":row{"
":spacer{width=1;fixed_width=true;}"
":column{width=33;fixed_width=true;"
":radio_button{key=\042rb_04\042;label=\042&Großschreibung\042;}"
":radio_button{key=\042rb_05\042;label=\042&Kleinschreibung\042;}"
":radio_button{key=\042rb_06\042;label=\042&1. Zeichen groß\042;}}}}"
":spacer{height=0.3;}"
":row{"
":spacer{width=3;}"
":column{width=0;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=3;}}}"))
(while abc30
(write-line (car abc30) abc29)
(setq abc30 (cdr abc30)))
(setq abc29 (close abc29))
abc28)
nil))
(defun acb15 ( / abc31 abc32 abc46 abc47 abc14)
(if (/= (type abc45) 'LIST)
(setq abc45 (list "0" "0" "0" "0" "0" "0")))
(if (setq abc31 (acb14))
(progn
(setq abc32 (load_dialog abc31))
(if (not (new_dialog "acm_cln" abc32))
(exit))
(vl-catch-all-apply 'vl-file-delete (list abc31))
(set_tile "tg_01" (nth 0 abc45))
(set_tile "tg_02" (nth 1 abc45))
(set_tile "tg_03" (nth 2 abc45))
(set_tile "tg_04" (nth 3 abc45))
(if (= (nth 4 abc45) "0")
(set_tile "rb_01" "1"))
(if (= (nth 4 abc45) "1")
(set_tile "rb_02" "1"))
(if (= (nth 4 abc45) "2")
(set_tile "rb_03" "1"))
(if (= (nth 5 abc45) "0")
(set_tile "rb_04" "1"))
(if (= (nth 5 abc45) "1")
(set_tile "rb_05" "1"))
(if (= (nth 5 abc45) "2")
(set_tile "rb_06" "1"))
(if (= (get_tile "tg_03") "0")
(progn
(mode_tile "rb_01" 1)
(mode_tile "rb_02" 1)
(mode_tile "rb_03" 1)))
(if (= (get_tile "tg_04") "0")
(progn
(mode_tile "rb_04" 1)
(mode_tile "rb_05" 1)
(mode_tile "rb_06" 1)))
(if
(and
(= (get_tile "tg_01") "0")
(= (get_tile "tg_02") "0")
(= (get_tile "tg_03") "0")
(= (get_tile "tg_04") "0"))
(mode_tile "b_01" 1))
(action_tile "tg_01" "(if
(and
(= $value \"0\")
(= (get_tile \"tg_02\") \"0\")
(= (get_tile \"tg_03\") \"0\")
(= (get_tile \"tg_04\") \"0\"))
(mode_tile \"b_01\" 1)
(mode_tile \"b_01\" 0)
)")
(action_tile "tg_02" "(if
(and
(= $value \"0\")
(= (get_tile \"tg_01\") \"0\")
(= (get_tile \"tg_03\") \"0\")
(= (get_tile \"tg_04\") \"0\"))
(mode_tile \"b_01\" 1)
(mode_tile \"b_01\" 0)
)")
(action_tile "tg_03" "(if
(and
(= $value \"0\")
(= (get_tile \"tg_01\") \"0\")
(= (get_tile \"tg_02\") \"0\")
(= (get_tile \"tg_04\") \"0\"))
(mode_tile \"b_01\" 1)
(mode_tile \"b_01\" 0))
(if (= $value \"1\")
(progn
(mode_tile \"rb_01\" 0)
(mode_tile \"rb_02\" 0)
(mode_tile \"rb_03\" 0))
(progn
(mode_tile \"rb_01\" 1)
(mode_tile \"rb_02\" 1)
(mode_tile \"rb_03\" 1))
)")
(action_tile "tg_04" "(if
(and
(= $value \"0\")
(= (get_tile \"tg_01\") \"0\")
(= (get_tile \"tg_02\") \"0\")
(= (get_tile \"tg_03\") \"0\"))
(mode_tile \"b_01\" 1)
(mode_tile \"b_01\" 0))
(if (= $value \"1\")
(progn
(mode_tile \"rb_04\" 0)
(mode_tile \"rb_05\" 0)
(mode_tile \"rb_06\" 0))
(progn
(mode_tile \"rb_04\" 1)
(mode_tile \"rb_05\" 1)
(mode_tile \"rb_06\" 1))
)")
(action_tile "b_01" "(if (= (get_tile \"rb_01\") \"1\")
(setq abc46 \"0\"))
(if (= (get_tile \"rb_02\") \"1\")
(setq abc46 \"1\"))
(if (= (get_tile \"rb_03\") \"1\")
(setq abc46 \"2\"))
(if (= (get_tile \"rb_04\") \"1\")
(setq abc47 \"0\"))
(if (= (get_tile \"rb_05\") \"1\")
(setq abc47 \"1\"))
(if (= (get_tile \"rb_06\") \"1\")
(setq abc47 \"2\"))
(setq abc14
(list
(get_tile \"tg_01\")
(get_tile \"tg_02\")
(get_tile \"tg_03\")
(get_tile \"tg_04\")
abc46
abc47))
(setq abc45 abc14)
(done_dialog)")
(action_tile "b_02" "(setq abc14 nil) (done_dialog)")
(start_dialog)
(unload_dialog abc32)))
abc14)
(defun acb16 (abc12 / abc48)
(setq abc48 abc12)
(if (/= (type abc45) 'LIST)
(setq abc45 (list "0" "0" "0" "0" "0" "0")))
(if (= (nth 0 abc45) "1")
(setq abc48 (cadr (acb11 abc48))))
(if (= (nth 1 abc45) "1")
(setq abc48 (cadr (acb13 abc48 6))))
(if (= (nth 2 abc45) "1")
(setq abc48 (cadr (acb12 abc48 (nth (atoi (nth 4 abc45)) (list 7 8 9))))))
(if (= (nth 3 abc45) "1")
(setq abc48 (acb01 abc48 (nth 5 abc45))))
abc48)
(defun acb17 (abc13 / abc49 abc50)
(if (tblsearch "DIMSTYLE" abc13)
(progn
(setq abc49 (vla-get-DimStyles (vla-get-ActiveDocument (vlax-get-acad-object))))
(setq abc50 (acb16 abc13))
(if (= (type (vl-catch-all-apply 'vla-put-Name (list (vla-Item abc49 abc13) abc50))) 'VL-CATCH-ALL-APPLY-ERROR)
(progn
(prompt (strcat "\n*Bemaßungsstil \042" abc13 "\042 konnte nicht umbenannt werden.* "))
(setq abc51 (1+ abc51)))
(progn
(if (/= abc13 abc50)
(setq abc52 (1+ abc52)))))))
abc50)
(defun acb18 ( / abc49 abc17 abc48 abc53)
(setq abc49 (vla-get-DimStyles (vla-get-ActiveDocument (vlax-get-acad-object))))
(vlax-for abc17 abc49
(if (not (vl-string-search "|" (setq abc48 (vlax-get abc17 'Name))))
(setq abc53 (cons abc48 abc53))))
abc53)
(defun acb19 ( / abc54 abc55 abc56 abc57 abc58 abc59 abc60)
(if (/= (type abc45) 'LIST)
(setq abc45 (list "0" "0" "0" "0" "0" "0")))
(setq abc54 (acb18))
(setq abc55 abc54)
(while abc55
(setq abc56 (car abc55))
(if (= (acb20 abc56) 1)
(setq abc57 (cons abc56 abc57)))
(setq abc55 (cdr abc55)))
(setq abc55 abc54)
(while abc55
(setq abc56 (car abc55))
(if (= (acb22 abc56) 1)
(setq abc58 (cons abc56 abc58)))
(setq abc55 (cdr abc55)))
(setq abc55 abc54)
(while abc55
(setq abc56 (car abc55))
(if (= (acb21 abc56) 1)
(setq abc59 (cons abc56 abc59)))
(setq abc55 (cdr abc55)))
(if (= (nth 3 abc45) "1")
(setq abc60 abc54)
(progn
(if (= (nth 0 abc45) "1")
(setq abc60 (append abc60 abc57)))
(if (= (nth 1 abc45) "1")
(setq abc60 (append abc60 abc58)))
(if (= (nth 2 abc45) "1")
(setq abc60 (append abc60 abc59)))))
(if (> (length abc60) 0)
(acad_strlsort abc60)
nil))
(defun acb20 (abc01 / )
(if
(or
(vl-string-search "ä" abc01)
(vl-string-search "ö" abc01)
(vl-string-search "ü" abc01)
(vl-string-search "Ä" abc01)
(vl-string-search "Ö" abc01)
(vl-string-search "Ü" abc01))
1
0))
(defun acb21 (abc01 / )
(if (vl-string-search " " abc01)
1
0))
(defun acb22 (abc01 / )
(if (vl-string-search "ß" abc01)
1
0))
(defun acb23 ( / abc61 abc62)
(initget "ausWahlliste Abbrechen")
(if (not (setq abc61 (getkword "\nÄnderungsoptionen anwenden auf alle Bemaßungsstile oder [ausWahlliste/Abbrechen] <alle Bemaßungsstile>: ")))
(setq abc62 0)
(progn
(if (= abc61 "ausWahlliste")
(setq abc62 1)
(setq abc62 -1))))
abc62)
(defun acb24 ( / abc44 abc63 abc64)
(if (setq abc44 (acb15))
(progn
(if (setq abc63 (acb19))
(progn
(setq abc64 (acb23))
(if (= abc64 -1)
(prompt "\nEs wurden keine Änderungen vorgenommen. "))
(if (= abc64 0)
(progn
(while abc63
(acb17 (car abc63))
(setq abc63 (cdr abc63)))))
(if (= abc64 1)
(progn
(if (setq abc63 (acb07 abc63))
(progn
(while abc63
(acb17 (car abc63))
(setq abc63 (cdr abc63))))
(prompt "\nEs wurden keine Änderungen vorgenommen. ")))))
(prompt "\nKeine änderbaren Bemaßungsstile in der Zeichnung vorhanden. ")))
(prompt "\nKeine Änderungsoptionen gewählt. ")))
(defun c:acm-bemstilnamenaendern ( / abc51
abc52
abc65
abc66)
(if (acb08)
(progn
(vl-load-com)
(setq abc51 0)
(setq abc52 0)
(setq abc65 (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq abc66 *error*)
(setq *error* acb09)
(vla-EndUndoMark abc65)
(vla-StartUndoMark abc65)
(acb24)
(if (> abc51 0)
(alert (strcat (itoa abc51) " Bemaßungsstil(e) konnte(n) nicht umbenannt werden (siehe Textfenster).")))
(prompt (strcat "\n*" (itoa abc52) " Bemaßungsstil(e) wurde(n) umbenannt.* "))
(if abc66
(setq *error* abc66)
(setq *error* nil))
(vla-EndUndoMark abc65)))
(princ))
(terpri)
(princ (strcat "\nAutoLISP-Tool ACM-BEMSTILNAMENAENDERN (Copyright © " (substr (rtos (getvar "CDATE")) 1 4) " Gerhard Rampf) geladen. "))
(princ "\nRufen Sie den Befehl mit ACM-BEMSTILNAMENAENDERN auf.")
