;;; - ------------------------------------------------------------------------------ - ;
;;; -                 T O O L - K_ATT-RENAME-ALL                                     - ;
;;; - ------------------------------------------------------------------------------ - ;
;;; - Beschreibung :  Alle Namen und Vorgabewerte von Attributen editieren           - ;
;;; - ------------------------------------------------------------------------------ - ;
;;; - Befehle      :  k_att-rename-all                                               - ;
;;; - ------------------------------------------------------------------------------ - ;
;;; - letzte Änderung am : 26.02.2024                                                - ;
;;; -              durch : Andreas Kraus                                             - ;
;;; - ------------------------------------------------------------------------------ - ;

(vl-load-com)
(DEFUN K_->ENT_NAME (NAME)
  (COND	((= (TYPE NAME) (QUOTE ENAME)) NAME)
	((= (TYPE NAME) (QUOTE VLA-OBJECT))
	 (vlax-vla-object->ename NAME)
	)
	((= (TYPE NAME) (QUOTE STR)) (HANDENT NAME))
	((AND (= (TYPE NAME) (QUOTE LIST)) (ASSOC -1 NAME))
	 (CDR (ASSOC -1 NAME))
	)
	((AND (= (TYPE NAME) (QUOTE LIST)) (ASSOC 5 NAME))
	 (HANDENT (CDR (ASSOC 5 NAME)))
	)
  )
)
(DEFUN K_AC-DOC	nil
  (vla-get-ActiveDocument (vlax-get-acad-object))
)
(DEFUN K_ALLE-OBJEKTE (FILE XREF SUBOBJ)
  (IF (NULL FILE)
    (SETQ FILE (K_AC-DOC))
  )
  (LENGTH
    (SETQ BLK_LIST (IF XREF
		     (K_COLLECTION->LIST (vla-get-Blocks FILE))
		     (PROGN (SETQ DUMMY (K_COLLECTION->LIST (vla-get-Blocks FILE)))
			    (K_FILTER (VL-REMOVE-IF-NOT
					(QUOTE (LAMBDA (BLK) (ENTGET (K_->ENT_NAME BLK))))
					DUMMY
				      )
				      (QUOTE ((ISXREF :vlax-false)))
			    )
		     )
		   )
    )
  )
  (SETQ ALLE_OBJ_LIST nil)
  (FOREACH BLK BLK_LIST
    (VLAX-FOR OBJ BLK
      (SETQ ALLE_OBJ_LIST (CONS OBJ ALLE_OBJ_LIST))
    )
  )
  (IF SUBOBJ
    (PROGN (LENGTH (SETQ ALLE_SUB_LIST
			  (VL-REMOVE-IF-NOT
			    (QUOTE
			      (LAMBDA (OBJ)
				(OR (= (vla-get-ObjectName OBJ) "AcDb3dPolyline")
				    (AND (= (vla-get-ObjectName OBJ) "AcDbBlockReference")
					 (K_IS (vla-get-HasAttributes OBJ))
				    )
				)
			      )
			    )
			    ALLE_OBJ_LIST
			  )
		   )
	   )
	   (LENGTH (SETQ ALLE_INS_LIST
			  (VL-REMOVE-IF-NOT
			    (QUOTE
			      (LAMBDA (OBJ)
				(AND (= (vla-get-ObjectName OBJ) "AcDbBlockReference")
				     (K_IS (vla-get-HasAttributes OBJ))
				)
			      )
			    )
			    ALLE_SUB_LIST
			  )
		   )
	   )
	   (SETQ ALLE_ATT_LIST
		  (APPLY (QUOTE APPEND)
			 (MAPCAR (QUOTE K_GET-ATTS) ALLE_INS_LIST)
		  )
	   )
	   (LENGTH (SETQ ALLE_POLYLINE_LIST
			  (VL-REMOVE-IF-NOT
			    (QUOTE
			      (LAMBDA (OBJ) (= (vla-get-ObjectName OBJ) "AcDb3dPolyline"))
			    )
			    ALLE_SUB_LIST
			  )
		   )
	   )
	   (SETQ ALLE_OBJ_LIST
		  (APPEND ALLE_OBJ_LIST
			  (APPLY (QUOTE APPEND)
				 (MAPCAR (QUOTE	(LAMBDA	(PL_OBJ / VERTEX_LIST)
						  (SETQ	ENT_NAME (vlax-vla-object->ename PL_OBJ)
							ENT_DATA (ENTGET ENT_NAME)
						  )
						  (WHILE (/= (CDR (ASSOC 0 ENT_DATA)) "SEQEND")
						    (IF	(= (CDR (ASSOC 0 ENT_DATA)) "VERTEX")
						      (SETQ VERTEX_LIST (CONS (vlax-ename->vla-object ENT_NAME) VERTEX_LIST))
						    )
						    (SETQ ENT_NAME (ENTNEXT ENT_NAME)
							  ENT_DATA (ENTGET ENT_NAME)
						    )
						  )
						  VERTEX_LIST
						)
					 )
					 ALLE_POLYLINE_LIST
				 )
			  )
		  )
	   )
	   (SETQ ALLE_OBJ_LIST (APPEND ALLE_OBJ_LIST ALLE_ATT_LIST))
    )
  )
  ALLE_OBJ_LIST
)
(DEFUN K_COLLECTION->LIST (COLLECTION / LISTE)
  (COND	((MEMBER "VLA-COLLECTION->LIST" (ATOMS-FAMILY 1))
	 (SETQ LISTE (VLA-COLLECTION->LIST COLLECTION))
	)
	((MEMBER "VLAX-FOR" (ATOMS-FAMILY 1))
	 (SETQ LISTE (LIST))
	 (VLAX-FOR DUMMY COLLECTION (SETQ LISTE (CONS DUMMY LISTE)))
	 (REVERSE LISTE)
	)
  )
  LISTE
)
(DEFUN K_COUNTER_LISTE (TODO TXT1 TXT2 LISTE)
  (DEFUN K_COUNTER_DIALOG_NEU nil
    (DONE_DIALOG)
    (NEW_DIALOG "k_counter_liste" K_COUNTER_DLG)
    (SETQ K_COUNTER_DIALOG_N 0)
  )
  (COND	((AND (= (TYPE TODO) (QUOTE STR)) (= (STRCASE TODO) "START"))
	 (SETQ K_COUNTER_DLG
		(LOAD_DIALOG "k_main.dcl")
	       K_COUNTER_LISTE_N 0
	 )
	 (COND ((AND TXT1 (= (TYPE TXT1) (QUOTE INT)))
		(SETQ K_COUNTER_LISTE_X TXT1)
	       )
	       ((AND TXT1 (= (TYPE TXT1) (QUOTE STR)))
		(SETQ K_COUNTER_LISTE_T TXT1)
	       )
	       (T (SETQ K_COUNTER_LISTE_X nil))
	 )
	 (IF (NOT (NEW_DIALOG "k_counter_liste" K_COUNTER_DLG))
	   (EXIT)
	 )
	 (IF TXT1
	   (SET_TILE "titel" (VL-PRINC-TO-STRING TXT1))
	 )
	)
	((AND (= (TYPE TODO) (QUOTE STR)) (= (STRCASE TODO) "END"))
	 (DONE_DIALOG)
	 (IF K_COUNTER_DLG
	   (UNLOAD_DIALOG K_COUNTER_DLG)
	 )
	 (SETQ K_COUNTER_LISTE_N nil
	       K_COUNTER_DLG nil
	 )
	)
	((AND (= (TYPE TODO) (QUOTE STR)) (= (STRCASE TODO) "SHOW"))
	 (SETQ K_COUNTER_LISTE_N (1+ K_COUNTER_LISTE_N))
	 (IF (AND K_COUNTER_LISTE_X
		  (>= K_COUNTER_LISTE_N K_COUNTER_LISTE_X)
	     )
	   (K_COUNTER_LISTE_NEU)
	 )
	 (SET_TILE "text1" (VL-PRINC-TO-STRING TXT1))
	 (SET_TILE "text2" (VL-PRINC-TO-STRING TXT2))
	 (START_LIST "liste")
	 (MAPCAR (QUOTE ADD_LIST)
		 (MAPCAR (QUOTE VL-PRINC-TO-STRING) LISTE)
	 )
	 (END_LIST)
	)
	(T nil)
  )
)
(DEFUN K_DEL-NTH (LISTE N / DUMMY_LIST)
  (REPEAT N
    (SETQ DUMMY_LIST (CONS (CAR LISTE) DUMMY_LIST)
	  LISTE	     (CDR LISTE)
    )
  )
  (APPEND (REVERSE DUMMY_LIST) (CDR LISTE))
)
(DEFUN K_FILTER	(OBJ_LIST FILTER_LIST)
  (IF (NOT (LISTP (CAR FILTER_LIST)))
    (SETQ FILTER_LIST (LIST FILTER_LIST))
  )
  (FOREACH FILTER FILTER_LIST
    (SETQ OBJ_LIST (VL-REMOVE-IF-NOT
		     (QUOTE
		       (LAMBDA (OBJ)
			 (IF (VL-CATCH-ALL-ERROR-P
			       (SETQ DUMMY (VL-CATCH-ALL-APPLY
					     (QUOTE EVAL)
					     (LIST
					       (LIST (READ (STRCAT "vla-get-" (VL-PRINC-TO-STRING (CAR FILTER))))
						     OBJ
					       )
					     )
					   )
			       )
			     )
			   nil
			   (EQUAL (K_VARIANT->VALUE
				    (EVAL
				      (LIST (READ (STRCAT "vla-get-" (VL-PRINC-TO-STRING (CAR FILTER))))
					    OBJ
				      )
				    )
				  )
				  (CADR FILTER)
			   )
			 )
		       )
		     )
		     OBJ_LIST
		   )
    )
  )
  OBJ_LIST
)
(DEFUN K_GET-ATTS (OBJ_NAME)
  (IF (AND (vlax-property-available-p OBJ_NAME "hasattributes")
	   (= (vla-get-HasAttributes OBJ_NAME) :vlax-true)
	   (NOT
	     (MINUSP (vlax-safearray-get-u-bound
		       (vlax-variant-value (vla-GetAttributes OBJ_NAME))
		       1
		     )
	     )
	   )
      )
    (vlax-invoke OBJ_NAME (QUOTE GETATTRIBUTES))
  )
)
(DEFUN K_GET-TEXTSTRING	(ENT_NAME / ENT_DATA)
  (SETQ	ENT_DATA (COND ((= (TYPE ENT_NAME) (QUOTE VLA-OBJECT))
			(ENTGET (vlax-vla-object->ename ENT_NAME))
		       )
		       ((= (TYPE ENT_NAME) (QUOTE ENAME)) (ENTGET ENT_NAME))
		       ((= (TYPE ENT_NAME) (QUOTE LIST)) ENT_NAME)
		 )
  )
  (WHILE (> (LENGTH (K_GET_ASSOC ENT_DATA 1)) 1)
    (SETQ ENT_DATA (K_DEL-NTH ENT_DATA
			      (VL-POSITION (ASSOC 1 ENT_DATA) ENT_DATA)
		   )
    )
  )
  (COND	((= (CDR (ASSOC 0 ENT_DATA)) "ATTDEF")
	 (APPLY	(QUOTE STRCAT)
		(MAPCAR	(QUOTE CDR)
			(APPEND	(K_GET_ASSOC ENT_DATA (QUOTE (1)))
				(CDR (K_GET_ASSOC ENT_DATA (QUOTE (3))))
			)
		)
	 )
	)
	((MEMBER (CDR (ASSOC 0 ENT_DATA))
		 (QUOTE ("TEXT" "MTEXT" "ATTRIB"))
	 )
	 (APPLY	(QUOTE STRCAT)
		(MAPCAR (QUOTE CDR) (K_GET_ASSOC ENT_DATA (QUOTE (1 3))))
	 )
	)
	((MEMBER (CDR (ASSOC 0 ENT_DATA)) (QUOTE ("MULTILEADER")))
	 (vla-get-TextString
	   (vlax-ename->vla-object (CDR (ASSOC -1 ENT_DATA)))
	 )
	)
	(T nil)
  )
)
(DEFUN K_GET_ASSOC (LISTE GRUPPE)
  (IF (/= (TYPE GRUPPE) (QUOTE LIST))
    (SETQ GRUPPE (LIST GRUPPE))
  )
  (VL-REMOVE-IF-NOT
    (QUOTE (LAMBDA (DATA) (MEMBER (CAR DATA) GRUPPE)))
    LISTE
  )
)
(DEFUN K_GET_MERKLISTE (NAME / WERT)
  (IF (ASSOC NAME K_MERKLISTE)
    (SETQ WERT (NTH 1 (ASSOC NAME K_MERKLISTE)))
  )
  WERT
)
(DEFUN K_IS (WERT)
  (COND	((= WERT :vlax-false) nil)
	((= WERT :vlax-true) T)
	((= WERT nil) nil)
	((= WERT T) T)
	((= WERT 1) T)
	((= WERT 0) nil)
	((= WERT "1") T)
	((= WERT "0") nil)
	((= (STRCASE WERT) "JA") T)
	((= (STRCASE WERT) "NEIN") nil)
  )
)
(DEFUN K_KILL-MTEXTFORMAT (TEXT / TXT OK)
  (IF (NOT (EQUAL TEXT ""))
    (PROGN (SETQ TXT TEXT)
	   (SETQ OK nil)
	   (WHILE (NOT OK)
	     (IF (SETQ POS1 (VL-STRING-SEARCH "\\O" TXT))
	       (IF (SETQ POS2 (VL-STRING-SEARCH "\\\\O" TXT))
		 (IF (/= (- POS1 POS2) 1)
		   (SETQ TXT (STRCAT (SUBSTR TXT 1 POS1) (SUBSTR TXT (+ POS1 3))))
		 )
		 (SETQ TXT (STRCAT (SUBSTR TXT 1 POS1) (SUBSTR TXT (+ POS1 3))))
	       )
	     )
	     (IF (SETQ POS1 (VL-STRING-SEARCH "\\o" TXT))
	       (IF (SETQ POS2 (VL-STRING-SEARCH "\\\\o" TXT))
		 (IF (/= (- POS1 POS2) 1)
		   (SETQ TXT (STRCAT (SUBSTR TXT 1 POS1) (SUBSTR TXT (+ POS1 3))))
		 )
		 (SETQ TXT (STRCAT (SUBSTR TXT 1 POS1) (SUBSTR TXT (+ POS1 3))))
	       )
	     )
	     (IF (SETQ POS1 (VL-STRING-SEARCH "\\L" TXT))
	       (IF (SETQ POS2 (VL-STRING-SEARCH "\\\\L" TXT))
		 (IF (/= (- POS1 POS2) 1)
		   (SETQ TXT (STRCAT (SUBSTR TXT 1 POS1) (SUBSTR TXT (+ POS1 3))))
		 )
		 (SETQ TXT (STRCAT (SUBSTR TXT 1 POS1) (SUBSTR TXT (+ POS1 3))))
	       )
	     )
	     (IF (SETQ POS1 (VL-STRING-SEARCH "\\l" TXT))
	       (IF (SETQ POS2 (VL-STRING-SEARCH "\\\\l" TXT))
		 (IF (/= (- POS1 POS2) 1)
		   (SETQ TXT (STRCAT (SUBSTR TXT 1 POS1) (SUBSTR TXT (+ POS1 3))))
		 )
		 (SETQ TXT (STRCAT (SUBSTR TXT 1 POS1) (SUBSTR TXT (+ POS1 3))))
	       )
	     )
	     (IF (SETQ POS1 (VL-STRING-SEARCH "\\~" TXT))
	       (IF (SETQ POS2 (VL-STRING-SEARCH "\\\\~" TXT))
		 (IF (/= (- POS1 POS2) 1)
		   (SETQ TXT (STRCAT (SUBSTR TXT 1 POS1) " " (SUBSTR TXT (+ POS1 3))))
		 )
		 (SETQ TXT (STRCAT (SUBSTR TXT 1 POS1) " " (SUBSTR TXT (+ POS1 3))))
	       )
	     )
	     (IF (SETQ POS1 (VL-STRING-SEARCH "{" TXT))
	       (IF (SETQ POS2 (VL-STRING-SEARCH "\\{" TXT))
		 (IF (/= (- POS1 POS2) 1)
		   (SETQ TXT (STRCAT (SUBSTR TXT 1 POS1) (SUBSTR TXT (+ POS1 2))))
		 )
		 (SETQ TXT (STRCAT (SUBSTR TXT 1 POS1) (SUBSTR TXT (+ POS1 2))))
	       )
	     )
	     (IF (SETQ POS1 (VL-STRING-SEARCH "}" TXT))
	       (IF (SETQ POS2 (VL-STRING-SEARCH "\\}" TXT))
		 (IF (/= (- POS1 POS2) 1)
		   (SETQ TXT (STRCAT (SUBSTR TXT 1 POS1) (SUBSTR TXT (+ POS1 2))))
		 )
		 (SETQ TXT (STRCAT (SUBSTR TXT 1 POS1) (SUBSTR TXT (+ POS1 2))))
	       )
	     )
	     (IF (SETQ POS1 (VL-STRING-SEARCH "\\C" TXT))
	       (IF (SETQ POS2 (VL-STRING-SEARCH "\\\\C" TXT))
		 (IF (/= (- POS1 POS2) 1)
		   (IF (SETQ POS3 (VL-STRING-SEARCH ";" TXT POS1))
		     (SETQ TXT (STRCAT (SUBSTR TXT 1 POS1) (SUBSTR TXT (+ POS3 2))))
		   )
		 )
		 (IF (SETQ POS3 (VL-STRING-SEARCH ";" TXT POS1))
		   (SETQ TXT (STRCAT (SUBSTR TXT 1 POS1) (SUBSTR TXT (+ POS3 2))))
		 )
	       )
	     )
	     (IF (SETQ POS1 (VL-STRING-SEARCH "\\c" TXT))
	       (IF (SETQ POS2 (VL-STRING-SEARCH "\\\\c" TXT))
		 (IF (/= (- POS1 POS2) 1)
		   (IF (SETQ POS3 (VL-STRING-SEARCH ";" TXT POS1))
		     (SETQ TXT (STRCAT (SUBSTR TXT 1 POS1) (SUBSTR TXT (+ POS3 2))))
		   )
		 )
		 (IF (SETQ POS3 (VL-STRING-SEARCH ";" TXT POS1))
		   (SETQ TXT (STRCAT (SUBSTR TXT 1 POS1) (SUBSTR TXT (+ POS3 2))))
		 )
	       )
	     )
	     (IF (SETQ POS1 (VL-STRING-SEARCH "\\H" TXT))
	       (IF (SETQ POS2 (VL-STRING-SEARCH "\\\\H" TXT))
		 (IF (/= (- POS1 POS2) 1)
		   (IF (SETQ POS3 (VL-STRING-SEARCH ";" TXT POS1))
		     (SETQ TXT (STRCAT (SUBSTR TXT 1 POS1) (SUBSTR TXT (+ POS3 2))))
		   )
		 )
		 (IF (SETQ POS3 (VL-STRING-SEARCH ";" TXT POS1))
		   (SETQ TXT (STRCAT (SUBSTR TXT 1 POS1) (SUBSTR TXT (+ POS3 2))))
		 )
	       )
	     )
	     (IF (SETQ POS1 (VL-STRING-SEARCH "\\S" TXT))
	       (IF (SETQ POS2 (VL-STRING-SEARCH "\\\\S" TXT))
		 (IF (/= (- POS1 POS2) 1)
		   (IF (SETQ POS3 (VL-STRING-SEARCH ";" TXT POS1))
		     (SETQ TXT (STRCAT (SUBSTR TXT 1 POS1) (SUBSTR TXT (+ POS3 2))))
		   )
		 )
		 (IF (SETQ POS3 (VL-STRING-SEARCH ";" TXT POS1))
		   (SETQ TXT (STRCAT (SUBSTR TXT 1 POS1) (SUBSTR TXT (+ POS3 2))))
		 )
	       )
	     )
	     (IF (SETQ POS1 (VL-STRING-SEARCH "\\T" TXT))
	       (IF (SETQ POS2 (VL-STRING-SEARCH "\\\\T" TXT))
		 (IF (/= (- POS1 POS2) 1)
		   (IF (SETQ POS3 (VL-STRING-SEARCH ";" TXT POS1))
		     (SETQ TXT (STRCAT (SUBSTR TXT 1 POS1) (SUBSTR TXT (+ POS3 2))))
		   )
		 )
		 (IF (SETQ POS3 (VL-STRING-SEARCH ";" TXT POS1))
		   (SETQ TXT (STRCAT (SUBSTR TXT 1 POS1) (SUBSTR TXT (+ POS3 2))))
		 )
	       )
	     )
	     (IF (SETQ POS1 (VL-STRING-SEARCH "\\Q" TXT))
	       (IF (SETQ POS2 (VL-STRING-SEARCH "\\\\Q" TXT))
		 (IF (/= (- POS1 POS2) 1)
		   (IF (SETQ POS3 (VL-STRING-SEARCH ";" TXT POS1))
		     (SETQ TXT (STRCAT (SUBSTR TXT 1 POS1) (SUBSTR TXT (+ POS3 2))))
		   )
		 )
		 (IF (SETQ POS3 (VL-STRING-SEARCH ";" TXT POS1))
		   (SETQ TXT (STRCAT (SUBSTR TXT 1 POS1) (SUBSTR TXT (+ POS3 2))))
		 )
	       )
	     )
	     (IF (SETQ POS1 (VL-STRING-SEARCH "\\W" TXT))
	       (IF (SETQ POS2 (VL-STRING-SEARCH "\\\\W" TXT))
		 (IF (/= (- POS1 POS2) 1)
		   (IF (SETQ POS3 (VL-STRING-SEARCH ";" TXT POS1))
		     (SETQ TXT (STRCAT (SUBSTR TXT 1 POS1) (SUBSTR TXT (+ POS3 2))))
		   )
		 )
		 (IF (SETQ POS3 (VL-STRING-SEARCH ";" TXT POS1))
		   (SETQ TXT (STRCAT (SUBSTR TXT 1 POS1) (SUBSTR TXT (+ POS3 2))))
		 )
	       )
	     )
	     (IF (SETQ POS1 (VL-STRING-SEARCH "\\A" TXT))
	       (IF (SETQ POS2 (VL-STRING-SEARCH "\\\\A" TXT))
		 (IF (/= (- POS1 POS2) 1)
		   (IF (SETQ POS3 (VL-STRING-SEARCH ";" TXT POS1))
		     (SETQ TXT (STRCAT (SUBSTR TXT 1 POS1) (SUBSTR TXT (+ POS3 2))))
		   )
		 )
		 (IF (SETQ POS3 (VL-STRING-SEARCH ";" TXT POS1))
		   (SETQ TXT (STRCAT (SUBSTR TXT 1 POS1) (SUBSTR TXT (+ POS3 2))))
		 )
	       )
	     )
	     (IF (SETQ POS1 (VL-STRING-SEARCH "\\f" TXT))
	       (IF (SETQ POS2 (VL-STRING-SEARCH "\\\\f" TXT))
		 (IF (/= (- POS1 POS2) 1)
		   (IF (SETQ POS3 (VL-STRING-SEARCH ";" TXT POS1))
		     (SETQ TXT (STRCAT (SUBSTR TXT 1 POS1) (SUBSTR TXT (+ POS3 2))))
		   )
		 )
		 (IF (SETQ POS3 (VL-STRING-SEARCH ";" TXT POS1))
		   (SETQ TXT (STRCAT (SUBSTR TXT 1 POS1) (SUBSTR TXT (+ POS3 2))))
		 )
	       )
	     )
	     (IF (SETQ POS1 (VL-STRING-SEARCH "\\pi" TXT))
	       (IF (SETQ POS2 (VL-STRING-SEARCH "\\\\pi" TXT))
		 (IF (/= (- POS1 POS2) 1)
		   (IF (SETQ POS3 (VL-STRING-SEARCH ";" TXT POS1))
		     (SETQ TXT (STRCAT (SUBSTR TXT 1 POS1) (SUBSTR TXT (+ POS3 2))))
		   )
		 )
		 (IF (SETQ POS3 (VL-STRING-SEARCH ";" TXT POS1))
		   (SETQ TXT (STRCAT (SUBSTR TXT 1 POS1) (SUBSTR TXT (+ POS3 2))))
		 )
	       )
	     )
	     (IF (SETQ POS1 (VL-STRING-SEARCH "\\pxi" TXT))
	       (IF (SETQ POS2 (VL-STRING-SEARCH "\\\\pxi" TXT))
		 (IF (/= (- POS1 POS2) 1)
		   (IF (SETQ POS3 (VL-STRING-SEARCH ";" TXT POS1))
		     (SETQ TXT (STRCAT (SUBSTR TXT 1 POS1) (SUBSTR TXT (+ POS3 2))))
		   )
		 )
		 (IF (SETQ POS3 (VL-STRING-SEARCH ";" TXT POS1))
		   (SETQ TXT (STRCAT (SUBSTR TXT 1 POS1) (SUBSTR TXT (+ POS3 2))))
		 )
	       )
	     )
	     (IF (SETQ POS1 (VL-STRING-SEARCH "\\pxqc" TXT))
	       (IF (SETQ POS2 (VL-STRING-SEARCH "\\\\pxqc" TXT))
		 (IF (/= (- POS1 POS2) 1)
		   (IF (SETQ POS3 (VL-STRING-SEARCH ";" TXT POS1))
		     (SETQ TXT (STRCAT (SUBSTR TXT 1 POS1) (SUBSTR TXT (+ POS3 2))))
		   )
		 )
		 (IF (SETQ POS3 (VL-STRING-SEARCH ";" TXT POS1))
		   (SETQ TXT (STRCAT (SUBSTR TXT 1 POS1) (SUBSTR TXT (+ POS3 2))))
		 )
	       )
	     )
	     (IF (SETQ POS1 (VL-STRING-SEARCH "\\pxqr" TXT))
	       (IF (SETQ POS2 (VL-STRING-SEARCH "\\\\pxqc" TXT))
		 (IF (/= (- POS1 POS2) 1)
		   (IF (SETQ POS3 (VL-STRING-SEARCH ";" TXT POS1))
		     (SETQ TXT (STRCAT (SUBSTR TXT 1 POS1) (SUBSTR TXT (+ POS3 2))))
		   )
		 )
		 (IF (SETQ POS3 (VL-STRING-SEARCH ";" TXT POS1))
		   (SETQ TXT (STRCAT (SUBSTR TXT 1 POS1) (SUBSTR TXT (+ POS3 2))))
		 )
	       )
	     )
	     (IF (SETQ POS1 (VL-STRING-SEARCH "\\pxql" TXT))
	       (IF (SETQ POS2 (VL-STRING-SEARCH "\\\\pxql" TXT))
		 (IF (/= (- POS1 POS2) 1)
		   (IF (SETQ POS3 (VL-STRING-SEARCH ";" TXT POS1))
		     (SETQ TXT (STRCAT (SUBSTR TXT 1 POS1) (SUBSTR TXT (+ POS3 2))))
		   )
		 )
		 (IF (SETQ POS3 (VL-STRING-SEARCH ";" TXT POS1))
		   (SETQ TXT (STRCAT (SUBSTR TXT 1 POS1) (SUBSTR TXT (+ POS3 2))))
		 )
	       )
	     )
	     (IF (SETQ POS1 (VL-STRING-SEARCH "\\p" TXT))
	       (IF (SETQ POS2 (VL-STRING-SEARCH "\\\\p" TXT))
		 (IF (/= (- POS1 POS2) 1)
		   (IF (SETQ POS3 (VL-STRING-SEARCH ";" TXT POS1))
		     (SETQ TXT (STRCAT (SUBSTR TXT 1 POS1) (SUBSTR TXT (+ POS3 2))))
		   )
		 )
		 (IF (SETQ POS3 (VL-STRING-SEARCH ";" TXT POS1))
		   (SETQ TXT (STRCAT (SUBSTR TXT 1 POS1) (SUBSTR TXT (+ POS3 2))))
		 )
	       )
	     )
	     (IF (EQUAL TEXT TXT)
	       (SETQ OK T)
	       (SETQ TEXT TXT)
	     )
	   )
    )
    (SETQ TXT TEXT)
  )
  TXT
)
(DEFUN K_MEM_LAYSTAT (/ LAYSTATLIST LAY)
  (SETQ	LAYSTATLIST
	 (MAPCAR (QUOTE	(LAMBDA	(LAY)
			  (LIST	(vla-get-Name LAY)
				(vla-get-LayerOn LAY)
				(vla-get-Freeze LAY)
				(vla-get-Lock LAY)
			  )
			)
		 )
		 (K_COLLECTION->LIST (vla-get-Layers (K_AC-DOC)))
	 )
  )
  (K_PUT_MERKLISTE
    "k_mem_laystat"
    (VL-REMOVE (QUOTE nil)
	       (CONS LAYSTATLIST (K_GET_MERKLISTE "k_mem_laystat"))
    )
  )
  (PRINC)
)
(DEFUN K_PURGE_LIST (LISTE / DUMMY_LIST)
  (WHILE LISTE
    (SETQ DUMMY_LIST (CONS (CAR LISTE) DUMMY_LIST)
	  LISTE	     (VL-REMOVE (CAR LISTE) LISTE)
    )
  )
  (REVERSE DUMMY_LIST)
)
(DEFUN K_PUT_MERKLISTE (NAME WERT)
  (IF (ASSOC NAME K_MERKLISTE)
    (SETQ K_MERKLISTE
	   (SUBST (LIST NAME WERT)
		  (ASSOC NAME K_MERKLISTE)
		  K_MERKLISTE
	   )
    )
    (SETQ K_MERKLISTE (CONS (LIST NAME WERT) K_MERKLISTE))
  )
  (PRINC)
)
(DEFUN K_RST_LAYSTAT (/ OBJ_NAME DAT)
  (SETVAR "cmdecho" 0)
  (FOREACH DAT (CAR (K_GET_MERKLISTE "k_mem_laystat"))
    (IF	(AND (TBLSEARCH "LAYER" (NTH 0 DAT))
	     (SETQ OBJ_NAME (vla-Item (vla-get-Layers (K_AC-DOC)) (NTH 0 DAT)))
	)
      (PROGN (vla-put-LayerOn OBJ_NAME (NTH 1 DAT))
	     (IF (/= (CAR DAT) (GETVAR "clayer"))
	       (vla-put-Freeze OBJ_NAME (NTH 2 DAT))
	     )
	     (vla-put-Lock OBJ_NAME (NTH 3 DAT))
      )
    )
  )
  (IF (CDR (K_GET_MERKLISTE "k_mem_laystat"))
    (K_PUT_MERKLISTE
      "k_mem_laystat"
      (CDR (K_GET_MERKLISTE "k_mem_laystat"))
    )
  )
  (PRINC)
)
(DEFUN K_VARIANT->VALUE	(VAR / VALUE)
  (IF (= (TYPE VAR) (QUOTE variant))
    (PROGN (SETQ VALUE (vlax-variant-value VAR))
	   (COND ((= (TYPE VALUE) (QUOTE safearray))
		  (IF (MINUSP (vlax-safearray-get-u-bound VALUE 1))
		    nil
		    (vlax-safearray->list VALUE)
		  )
		 )
		 (T VALUE)
	   )
    )
    VAR
  )
)
(DEFUN K_VL-SORT (LISTE SORTFUNCTION)
  (MAPCAR (QUOTE (LAMBDA (I) (NTH I LISTE)))
	  (VL-SORT-I (MAPCAR (QUOTE STRCASE)
			     (MAPCAR (QUOTE VL-PRINC-TO-STRING) LISTE)
		     )
		     SORTFUNCTION
	  )
  )
)

(defun c:k_att-rename-all (/ $REASON A016_ID ATT CONTENT_LIST LISTE LISTEN_LIST	OK_DLG PROMPT_LIST TAG_LIST TEXT_LIST TXT TXT_DATA TXT_LIST)
;;; Attributdaten editieren
  (defun a016_end (wert)
    (setq ok_dlg wert)
    (done_dialog)
  )

  (defun a016_liste_update (txt_list)
    (start_list "txt_list")
    (mapcar 'add_list
	    (mapcar '(lambda (txt) (strcat (car txt) " - " (cadr txt)))
		    txt_list
	    )
    )
    (end_list)
  )

  (defun a016_liste ()
    (setq liste (nth (atoi (get_tile "listen")) listen_list))
    (cond
      ((= liste "Text")
       (setq txt_list text_list)
      )
      ((= liste "Tag")
       (setq txt_list tag_list)
      )
      ((= liste "Prompt")
       (setq txt_list prompt_list)
      )
      ((= liste "Vorgabewert")
       (setq txt_list content_list)
      )
    )
    (a016_liste_update txt_list)
    (set_tile "txt" "")
  )

  (defun a016_txt_list ()
    (setq txt_data (nth (atoi (get_tile "txt_list")) txt_list))
    (set_tile "txt" (nth 1 txt_data))
    (mode_tile "txt" 2)
  )

  (defun a016_txt ()
    (if	(= $reason 1)
      (progn
	(setq
	  txt_list (subst (list (nth 0 txt_data) (get_tile "txt"))
			  (assoc (nth 0 txt_data) txt_list)
			  txt_list
		   )
	)
	(cond
	  ((= liste "Text")
	   (setq text_list txt_list)
	  )
	  ((= liste "Tag")
	   (setq tag_list txt_list)
	  )
	  ((= liste "Prompt")
	   (setq prompt_list txt_list)
	  )
	  ((= liste "Vorgabewert")
	   (setq content_list txt_list)
	  )
	)
	(a016_liste_update txt_list)
      )
    )
  )

  (vla-startundomark (k_ac-doc))

  (foreach obj_name (vl-remove-if-not
		      '(lambda (obj)
			 (or (= (vla-get-ObjectName obj) "AcDbBlockReference")
			     (= (vla-get-ObjectName obj) "AcDbAttributeDefinition")
			 )
		       )
		      (k_alle-objekte (k_ac-doc) nil nil)
		    )
    (cond
      ((= (vla-get-ObjectName obj_name) "AcDbBlockReference")
       (if (and	(vlax-property-available-p obj_name "hasattributes")
		(= (vla-get-hasattributes obj_name) :vlax-true)
		(not (minusp (vlax-safearray-get-u-bound
			       (vlax-variant-value
				 (vla-getattributes obj_name)
			       )
			       1
			     )
		     )
		)
	   )
	 (setq text_list (append text_list
				 (mapcar 'k_kill-mtextformat
					 (mapcar
					   '(lambda (att)
					      (k_get-textstring att)
					    )
					   (vlax-invoke obj_name 'GetAttributes)
					 )
				 )
			 )
	       tag_list	 (append tag_list
				 (mapcar 'k_kill-mtextformat
					 (mapcar
					   '(lambda (att)
					      (vla-get-tagstring att)
					    )
					   (vlax-invoke obj_name 'GetAttributes)
					 )
				 )
			 )
	 )
       )
      )
      ((= (vla-get-ObjectName obj_name) "AcDbAttributeDefinition")
       (setq
	 content_list
		      (cons (k_get-textstring obj_name)
			    content_list
		      )
	 prompt_list
		      (cons
			(k_kill-mtextformat (vla-get-PromptString obj_name))
			prompt_list
		      )
	 tag_list     (cons (k_kill-mtextformat (vla-get-TagString obj_name))
			    tag_list
		      )
       )
      )
    )
  )

  (k_counter_liste "end" nil nil nil)
  (setq	tag_list
		     (mapcar '(lambda (txt)
				(list txt txt)
			      )
			     (k_vl-sort (k_purge_list tag_list) '<)
		     )
	prompt_list
		     (mapcar '(lambda (txt)
				(list txt txt)
			      )
			     (k_vl-sort (k_purge_list prompt_list) '<)
		     )
	text_list
		     (mapcar '(lambda (txt)
				(list txt txt)
			      )
			     (k_vl-sort (k_purge_list text_list) '<)
		     )
	content_list
		     (mapcar '(lambda (txt)
				(list txt txt)
			      )
			     (k_vl-sort (k_purge_list content_list) '<)
		     )
	listen_list  (list "Text" "Tag" "Prompt" "Vorgabewert")
  )
  (setq k_att-rename-all_id (load_dialog "k_att-rename-all.dcl"))
  (if (not (new_dialog "k_att_rename_all" k_att-rename-all_id))
    (exit)
  )
  (start_list "listen")
  (mapcar 'add_list listen_list)
  (end_list)
  (set_tile "listen" "1")
  (a016_liste)
  (action_tile "listen" "(a016_liste)")
  (action_tile "txt_list" "(a016_txt_list)")
  (action_tile "txt" "(a016_txt)")
  (action_tile "accept" "(a016_end 1)")
  (action_tile "cancel" "(a016_end 0)")
  (start_dialog)
  (unload_dialog k_att-rename-all_id)
  (if (= ok_dlg 1)
    (progn
;;; Laer entsperren
      (k_mem_laystat)
      (vlax-for	lay (vla-get-layers (k_ac-doc))
	(vla-put-lock lay :vlax-false)
      )
      (foreach obj_name	(vl-remove-if-not
			  '(lambda (obj)
			     (or (= (vla-get-ObjectName obj) "AcDbBlockReference")
				 (= (vla-get-ObjectName obj) "AcDbAttributeDefinition")
			     )
			   )
			  (k_alle-objekte (k_ac-doc) nil nil)
			)
	(cond
	  ((= (vla-get-ObjectName obj_name) "AcDbBlockReference")
	   (if (and (vlax-property-available-p obj_name "hasattributes")
		    (= (vla-get-hasattributes obj_name) :vlax-true)
		    (not (minusp (vlax-safearray-get-u-bound
				   (vlax-variant-value
				     (vla-getattributes obj_name)
				   )
				   1
				 )
			 )
		    )
	       )
	     (progn
	       (mapcar
		 '(lambda (att)
		    (if	(assoc (k_kill-mtextformat
				 (k_get-textstring att)
			       )
			       text_list
			)
		      (vla-put-textstring
			att
			(cadr (assoc (k_kill-mtextformat
				       (k_get-textstring att)
				     )
				     text_list
			      )
			)
		      )
		    )
		    (if	(assoc (vla-get-tagstring att)
			       tag_list
			)
		      (vla-put-tagstring
			att
			(cadr (assoc (vla-get-tagstring att)
				     tag_list
			      )
			)
		      )
		    )
		    (if	(assoc (vla-get-MTextAttributeContent att)
			       content_list
			)
		      (vla-put-MTextAttributeContent
			att
			(cadr (assoc (vla-get-MTextAttributeContent att)
				     content_list
			      )
			)
		      )
		    )
		  )
		 (vlax-invoke obj_name 'GetAttributes)
	       )
	     )
	   )
	  )
	  ((= (vla-get-ObjectName obj_name) "AcDbAttributeDefinition")
	   (if (assoc (k_kill-mtextformat
			(vla-get-MTextAttributeContent obj_name)
		      )
		      content_list
	       )
	     (vla-put-TextString
	       obj_name
	       (cadr (assoc (k_get-textstring obj_name)
			    content_list
		     )
	       )
	     )
	   )
	   (if (assoc (k_kill-mtextformat
			(vla-get-PromptString obj_name)
		      )
		      prompt_list
	       )
	     (vla-put-PromptString
	       obj_name
	       (cadr (assoc (k_kill-mtextformat
			      (vla-get-PromptString obj_name)
			    )
			    prompt_list
		     )
	       )
	     )
	   )
	   (if (assoc (k_kill-mtextformat
			(vla-get-TagString obj_name)
		      )
		      tag_list
	       )
	     (vla-put-TagString
	       obj_name
	       (cadr (assoc (k_kill-mtextformat
			      (vla-get-TagString obj_name)
			    )
			    tag_list
		     )
	       )
	     )
	   )
	  )
	)
      )
      (k_rst_laystat)
    )
  )
  (vla-endundomark (k_ac-doc))
  (princ)
)
;;; - ------------------------------------------------------------------------------ - ;
(princ
  (strcat
    "\nk_att-rename-all:  Alle Namen und Vorgabewerte von Attributen editieren"
    "\n===========  "
    "\n(C) Andreas Kraus 2024 (info@kraus-cad.de)"
    "\nBefehlszeilenaufruf : k_att-rename-all\n"
  )
)
;;; - ------------------------------------------------------------------------------ - ;
(princ)