;;; - ------------------------------------------------------------------------------ - ;
;;; -                 T O O L - K_TXT2ATT                                            - ;
;;; - ------------------------------------------------------------------------------ - ;
;;; - Beschreibung :  Texte in Attribute übertragen                                  - ;
;;; - ------------------------------------------------------------------------------ - ;
;;; - Befehle      :  k_txt2att                                                      - ;
;;; - ------------------------------------------------------------------------------ - ;
;;; - letzte Änderung am : 01.01.2024                                                - ;
;;; -              durch : Andreas Kraus                                             - ;
;;; - ------------------------------------------------------------------------------ - ;

(vl-load-com)
(DEFUN COMPARE (E0 E1 /)
  (COND	((> (CAR E0) (CAR E1)) 1)
	((< (CAR E0) (CAR E1)) -1)
	((QUOTE T) 0)
  )
)
(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_->OBJ_NAME (NAME)
  (COND	((= (TYPE NAME) (QUOTE ENAME))
	 (vlax-ename->vla-object NAME)
	)
	((= (TYPE NAME) (QUOTE VLA-OBJECT)) NAME)
	((= (TYPE NAME) (QUOTE STR))
	 (vlax-ename->vla-object (HANDENT NAME))
	)
	((AND (= (TYPE NAME) (QUOTE LIST)) (ASSOC -1 NAME))
	 (vlax-ename->vla-object (CDR (ASSOC -1 NAME)))
	)
	((AND (= (TYPE NAME) (QUOTE LIST)) (ASSOC 5 NAME))
	 (vlax-ename->vla-object (HANDENT (CDR (ASSOC 5 NAME))))
	)
  )
)
(DEFUN K_AC-DOC	nil
  (vla-get-ActiveDocument (vlax-get-acad-object))
)
(DEFUN K_ACBC (DUMMY1 DUMMY2)
  (IF (AND (VL-STRING-SEARCH "BricsCAD" (GETVAR "acadver")))
    DUMMY2
    DUMMY1
  )
)
(DEFUN K_AUSWAHL_LISTE (REF_LISTE    MULTI	  RÜCKGABE     TITEL	    FILTER_LIST	 VORAUSWAHL   /		   AUSWAHL_LISTE_ID	     DUMMY_LIST
			AUSWAHL	     OK_AUSWAHL_LISTE	       ANZEIGE_LISTE		 DATA	      EINTRAG	   FILTER	LISTE	     MARKER_LISTE
			N	     NICHT	  STELLE       TXT	    WAHL
		       )
  (DEFUN END_AUSWAHL_LISTE (WERT)
    (SETQ OK_AUSWAHL_LISTE WERT)
    (SETQ AUSWAHL (EVAL (READ (STRCAT "(list " (GET_TILE "liste") ")"))))
    (DONE_DIALOG)
  )
  (DEFUN AUSWAHL_LISTE_LISTE nil
    (SETQ AUSWAHL (READ (STRCAT "(" (GET_TILE "liste") ")")))
    (SET_TILE "anzahl" (ITOA (LENGTH AUSWAHL)))
    (IF	(= $REASON 4)
      (END_AUSWAHL_LISTE 1)
    )
  )
  (DEFUN AUSWAHL_LISTE_STELLE nil
    (SETQ MARKER_LISTE (GET_TILE "liste"))
    (IF	(GET_TILE "stelle")
      (SETQ STELLE (MAX 1 (ATOI (GET_TILE "stelle"))))
      (SETQ STELLE 1)
    )
    (SETQ NICHT (GET_TILE "nicht"))
    (SETQ FILTER (GET_TILE "filter"))
    (IF	(EQUAL NICHT "")
      (SETQ LISTE REF_LISTE)
      (SETQ LISTE (VL-REMOVE-IF
		    (QUOTE
		      (LAMBDA (EINTRAG)
			(WCMATCH (STRCASE (VL-PRINC-TO-STRING (CAR EINTRAG)))
				 (STRCASE (STRCAT "*" NICHT "*"))
			)
		      )
		    )
		    REF_LISTE
		  )
      )
    )
    (SETQ LISTE	(VL-REMOVE-IF-NOT
		  (QUOTE
		    (LAMBDA (EINTRAG)
		      (WCMATCH (STRCASE (VL-PRINC-TO-STRING (CAR EINTRAG)))
			       (STRCASE (STRCAT "*" FILTER "*"))
		      )
		    )
		  )
		  LISTE
		)
    )
    (SETQ ANZEIGE_LISTE
	   (MAPCAR (QUOTE (LAMBDA (TXT)
			    (SUBSTR (VL-PRINC-TO-STRING (CAR TXT)) STELLE)
			  )
		   )
		   LISTE
	   )
    )
    (START_LIST "liste")
    (MAPCAR (QUOTE ADD_LIST) ANZEIGE_LISTE)
    (END_LIST)
    (SET_TILE "liste" MARKER_LISTE)
    (IF	(MAPCAR	(QUOTE (LAMBDA (DUMMY) (VL-POSITION DUMMY ANZEIGE_LISTE)))
		VORAUSWAHL
	)
      (SET_TILE	"liste"
		(VL-STRING-TRIM
		  "()"
		  (VL-PRINC-TO-STRING
		    (VL-REMOVE (QUOTE nil)
			       (MAPCAR (QUOTE
					 (LAMBDA (DUMMY)
					   (VL-POSITION (VL-PRINC-TO-STRING DUMMY) ANZEIGE_LISTE)
					 )
				       )
				       VORAUSWAHL
			       )
		    )
		  )
		)
      )
    )
  )
  (DEFUN AUSWAHL_LISTE_FILTER nil
    (SET_TILE "nicht"
	      (CADR (NTH (ATOI (GET_TILE "filter_list")) FILTER_LIST))
    )
    (AUSWAHL_LISTE_STELLE)
  )
  (SETQ N -1)
  (SETQ	REF_LISTE (MAPCAR (QUOTE (LAMBDA (DATA) (SETQ N (1+ N)) (LIST DATA N)))
			  REF_LISTE
		  )
  )
  (IF MULTI
    (SETQ MULTI (STRCASE MULTI))
  )
  (IF RÜCKGABE
    (SETQ RÜCKGABE (STRCASE RÜCKGABE))
  )
  (SETQ AUSWAHL_LISTE_ID (LOAD_DIALOG "k_txt2att.dcl"))
  (COND	((= MULTI "M")
	 (IF (NOT (NEW_DIALOG "auswahl_liste_multi" AUSWAHL_LISTE_ID))
	   (EXIT)
	 )
	)
	((= MULTI "S")
	 (IF (NOT (NEW_DIALOG "auswahl_liste_single" AUSWAHL_LISTE_ID))
	   (EXIT)
	 )
	)
  )
  (AUSWAHL_LISTE_STELLE)
  (SET_TILE "Titel" TITEL)
  (ACTION_TILE "accept" "(end_auswahl_liste 1)")
  (ACTION_TILE "cancel" "(end_auswahl_liste 0)")
  (ACTION_TILE "liste" "(auswahl_liste_liste)")
  (ACTION_TILE "stelle" "(auswahl_liste_stelle)")
  (ACTION_TILE "nicht" "(auswahl_liste_stelle)")
  (ACTION_TILE "filter" "(auswahl_liste_stelle)")
  (START_LIST "filter_list")
  (MAPCAR (QUOTE ADD_LIST) (MAPCAR (QUOTE CAR) FILTER_LIST))
  (END_LIST)
  (ACTION_TILE "filter_list" "(auswahl_liste_filter)")
  (SETQ VORAUSWAHL nil)
  (START_DIALOG)
  (UNLOAD_DIALOG AUSWAHL_LISTE_ID)
  (IF (= OK_AUSWAHL_LISTE 1)
    (PROGN (COND ((EQUAL RÜCKGABE "LISTE")
		  (SETQ	DUMMY_LIST
			 (MAPCAR (QUOTE
				   (LAMBDA (EINTRAG) (CAR (NTH (CADR EINTRAG) REF_LISTE)))
				 )
				 (MAPCAR (QUOTE (LAMBDA (WAHL) (NTH WAHL LISTE))) AUSWAHL)
			 )
		  )
		  (IF (= MULTI "S")
		    (SETQ DUMMY_LIST (CAR DUMMY_LIST))
		  )
		 )
		 ((EQUAL RÜCKGABE "INDEX")
		  (SETQ	DUMMY_LIST
			 (MAPCAR (QUOTE (LAMBDA (EINTRAG) (CADR EINTRAG)))
				 (MAPCAR (QUOTE (LAMBDA (WAHL) (NTH WAHL LISTE))) AUSWAHL)
			 )
		  )
		  (IF (= MULTI "S")
		    (SETQ DUMMY_LIST (CAR DUMMY_LIST))
		  )
		 )
		 (T
		  (SETQ	DUMMY_LIST
			 (MAPCAR (QUOTE
				   (LAMBDA (EINTRAG) (CAR (NTH (CADR EINTRAG) REF_LISTE)))
				 )
				 (MAPCAR (QUOTE (LAMBDA (WAHL) (NTH WAHL LISTE))) AUSWAHL)
			 )
		  )
		  (IF (= MULTI "S")
		    (SETQ DUMMY_LIST (CAR DUMMY_LIST))
		  )
		 )
	   )
    )
  )
  DUMMY_LIST
)
(DEFUN K_ENTLIST->SATZ (ENT_LIST / N SATZ ENT_NAME)
  (IF (NOT (LISTP ENT_LIST))
    (SETQ ENT_LIST (LIST ENT_LIST))
  )
  (IF (LISTP ENT_LIST)
    (PROGN (SETQ SATZ (SSADD))
	   (MAPCAR (QUOTE
		     (LAMBDA (ENT_NAME)
		       (COND ((AND (= (TYPE ENT_NAME) (QUOTE VLA-OBJECT))
				   (K_->ENT_NAME ENT_NAME)
			      )
			      (SETQ SATZ (SSADD (vlax-vla-object->ename ENT_NAME) SATZ))
			     )
			     ((AND (= (TYPE ENT_NAME) (QUOTE ENAME))
				   (K_->OBJ_NAME ENT_NAME)
			      )
			      (SETQ SATZ (SSADD ENT_NAME SATZ))
			     )
			     ((= (TYPE ENT_NAME) (QUOTE STR))
			      (IF (HANDENT ENT_NAME)
				(SETQ SATZ (SSADD (HANDENT ENT_NAME) SATZ))
			      )
			     )
		       )
		     )
		   )
		   ENT_LIST
	   )
    )
  )
  SATZ
)
(DEFUN K_ENTSELP (P / DUMMY ENT_NAME)
  (IF P
    (PROGN (SETQ DUMMY	  (NENTSELP P)
		 ENT_NAME (IF (AND (LISTP (LAST DUMMY))
				   (VL-EVERY (QUOTE (LAMBDA (Q) (= (TYPE Q) (QUOTE ENAME))))
					     (LAST DUMMY)
				   )
			      )
			    (LAST (LAST DUMMY))
			    (CAR DUMMY)
			  )
	   )
	   (IF (MEMBER (CDR (ASSOC 0 (ENTGET ENT_NAME)))
		       (QUOTE ("VERTEX" "ATTRIB"))
	       )
	     (CDR (ASSOC 330 (ENTGET ENT_NAME)))
	     ENT_NAME
	   )
    )
  )
)
(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_MERKLISTE (NAME / WERT)
  (IF (ASSOC NAME K_MERKLISTE)
    (SETQ WERT (NTH 1 (ASSOC NAME K_MERKLISTE)))
  )
  WERT
)
(DEFUN K_OBJLIST->SATZ (OBJ_LIST)
  (IF (NOT (LISTP OBJ_LIST))
    (SETQ OBJ_LIST (LIST OBJ_LIST))
  )
  (K_ENTLIST->SATZ
    (MAPCAR (QUOTE vlax-vla-object->ename) OBJ_LIST)
  )
)
(DEFUN K_OBJ_MIDP (OBJ / MINP MAXP W)
  (IF (= (vla-get-ObjectName OBJ) "AcDbMText")
    (PROGN (SETQ W (vla-get-Width OBJ)) (vla-put-Width OBJ 0))
  )
  (vla-GetBoundingBox OBJ (QUOTE MINP) (QUOTE MAXP))
  (IF (= (vla-get-ObjectName OBJ) "AcDbMText")
    (vla-put-Width OBJ W)
  )
  (MAPCAR (QUOTE (LAMBDA (X1 X2) (/ (+ X1 X2) 2)))
	  (vlax-safearray->list MINP)
	  (vlax-safearray->list MAXP)
  )
)
(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_RESTORE_VAR (VARLIST / K_SAVEVAR_LIST)
  (SETQ K_SAVEVAR_LIST (K_GET_MERKLISTE "k_savevar_list"))
  (IF (= VARLIST "*")
    (SETQ VARLIST (MAPCAR (QUOTE (LAMBDA (VAR) (NTH 0 VAR))) K_SAVEVAR_LIST))
  )
  (IF (= (TYPE VARLIST) (QUOTE STR))
    (SETQ VARLIST (LIST VARLIST))
  )
  (FOREACH VAR VARLIST
    (IF	(SETQ VAR (ASSOC VAR K_SAVEVAR_LIST))
      (SETVAR (NTH 0 VAR) (NTH 1 VAR))
    )
  )
)
(DEFUN K_SATZ->ENTLIST (SATZ)
  (IF (= (TYPE SATZ) (QUOTE PICKSET))
    (VL-REMOVE-IF-NOT
      (QUOTE (LAMBDA (DUMMY) (= (TYPE DUMMY) (QUOTE ENAME))))
      (MAPCAR (QUOTE CADR) (SSNAMEX SATZ))
    )
  )
)
(DEFUN K_SATZ->OBJLIST (SATZ)
  (MAPCAR (QUOTE vlax-ename->vla-object)
	  (K_SATZ->ENTLIST SATZ)
  )
)
(DEFUN K_SAVE_VAR (VARLIST / K_SAVEVAR_LIST)
  (SETQ K_SAVEVAR_LIST (K_GET_MERKLISTE "k_savevar_list"))
  (IF (= (TYPE VARLIST) (QUOTE STR))
    (SETQ VARLIST (LIST VARLIST))
  )
  (FOREACH VAR VARLIST
    (IF	(ASSOC VAR K_SAVEVAR_LIST)
      (SETQ K_SAVEVAR_LIST
	     (SUBST (LIST VAR (GETVAR VAR))
		    (ASSOC VAR K_SAVEVAR_LIST)
		    K_SAVEVAR_LIST
	     )
      )
      (SETQ K_SAVEVAR_LIST (CONS (LIST VAR (GETVAR VAR)) K_SAVEVAR_LIST))
    )
  )
  (K_PUT_MERKLISTE "k_savevar_list" K_SAVEVAR_LIST)
)
(DEFUN K_SSGET (TEXT FILTER / SATZ)
  (IF TEXT
    (PROGN (K_SAVE_VAR "NOMUTT")
	   (PRINC (STRCAT " " TEXT))
	   (SETVAR "NOMUTT" 1)
    )
  )
  (VL-CATCH-ALL-APPLY
    (LIST (QUOTE LAMBDA)
	  (QUOTE nil)
	  (QUOTE (SETQ SATZ (APPLY (QUOTE SSGET) FILTER)))
    )
  )
  (IF TEXT
    (K_RESTORE_VAR "NOMUTT")
  )
  SATZ
)
(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 L-CONJUNCTION (L0 L1 / CMP L2)
  (SETQ L0 (VL-SORT (MAKE-SORTABLE L0) (QUOTE _<)))
  (SETQ L1 (VL-SORT (MAKE-SORTABLE L1) (QUOTE _<)))
  (WHILE (AND L0 L1)
    (SETQ CMP (COMPARE (CAR L0) (CAR L1)))
    (COND ((= CMP -1) (SETQ L0 (CDR L0)))
	  ((= CMP 1) (SETQ L1 (CDR L1)))
	  ((QUOTE T)
	   (SETQ L2 (CONS (CDR (CAR L0)) L2)
		 L0 (CDR L0)
		 L1 (CDR L1)
	   )
	  )
    )
  )
  L2
)
(DEFUN MAKE-SORTABLE (L /)
  (MAPCAR (QUOTE (LAMBDA (E /) (CONS (VL-PRIN1-TO-STRING E) E)))
	  L
  )
)
(DEFUN PUNKT-OWC (C / OK WERT GR)
  (IF C
    (SETQ C 2)
    (SETQ C 0)
  )
  (SETQ OK T)
  (WHILE OK
    (SETQ GR (GRREAD T 7 C))
    (COND ((= (CAR GR) (K_ACBC 25 12))
	   (SETQ WERT nil
		 OK   nil
	   )
	  )
	  ((= (CAR GR) 3)
	   (SETQ WERT (CADR GR)
		 OK   nil
	   )
	  )
    )
  )
  WERT
)
(DEFUN _< (E0 E1 /) (< (CAR E0) (CAR E1)))

(defun c:k_txt2att (/ ATTMOVE ATT_NAME DUMMY ENT_NAME FILTER OBJ OBJ_A OBJ_LIST_A OBJ_LIST_I OBJ_LIST_T	OBJ_NAME OBJ_T OK SATZ)

  (defun txt-to-att (obj_t obj_a)
    (vla-put-textstring
      obj_a
      (vla-get-textstring obj_t)
    )
    (if	(= attmove "T")
      (progn
	(vla-put-color
	  obj_a
	  (vla-get-color obj_t)
	)
	(vla-put-height
	  obj_a
	  (vla-get-height obj_t)
	)
	(vla-put-StyleName
	  obj_a
	  (vla-get-StyleName obj_t)
	)
	(vla-put-Rotation
	  obj_a
	  (vla-get-Rotation obj_t)
	)
	(if (= (vla-get-alignment obj_a) 0)
	  (vla-put-InsertionPoint
	    obj_a
	    (VLAX-3D-POINT
	      (mapcar '+
		      (k_variant->value
			(vla-get-InsertionPoint obj_a)
		      )
		      (mapcar '-
			      (k_obj_midp obj_t)
			      (k_obj_midp obj_a)
		      )
	      )
	    )
	  )
	  (vla-put-TextAlignmentPoint
	    obj_a
	    (VLAX-3D-POINT
	      (mapcar
		'+
		(k_variant->value
		  (vla-get-TextAlignmentPoint obj_a)
		)
		(mapcar	'-
			(k_obj_midp obj_t)
			(k_obj_midp obj_a)
		)
	      )
	    )
	  )
	)
      )
    )
  )

  (vla-startundomark (k_ac-doc))
  (setq	filter (list (cons -4 "<OR")
		     (cons 0 "TEXT")
		     (cons 0 "MTEXT")
		     (cons 0 "ATTDEF")
		     (cons -4 "<AND")
		     (cons 0 "INSERT")
		     (cons 66 1)
		     (cons -4 "AND>")
		     (cons -4 "OR>")
	       )
  )
  (if (setq satz (ssget filter))
    (progn
      (setq obj_list_i
	     (k_filter (k_satz->objlist satz)
		       '((objectname "AcDbBlockReference"))
	     )
      )
      (setq obj_list_t
	     (append (k_filter (k_satz->objlist satz)
			       '((objectname "AcDbText"))
		     )
		     (k_filter (k_satz->objlist satz)
			       '((objectname "AcDbMText"))
		     )
		     (k_filter (k_satz->objlist satz)
			       '((objectname "AcDbAttributeDefinition"))
		     )
	     )
      )
      (cond
	((and (> (length obj_list_i) 0)
	      (> (length obj_list_t) 0)
	 )
	 (setq att_name
		(k_auswahl_liste
		  (vl-sort
		    (k_purge_list
		      (apply
			'append
			(mapcar
			  '(lambda (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
					      )
				      )
				 )
			       )
				(mapcar
				  '(lambda (obj)
				     (vla-get-tagstring obj)
				   )
				  (vlax-invoke obj_name 'GetAttributes)
				)
			     )
			   )
			  obj_list_i
			)
		      )
		    )
		    '<
		  )
		  "s"
		  "liste"
		  "Auswahl"
		  nil
		  nil
		)
	 )
	 (initget "A T")
	 (setq attmove
		(getkword
		  "[Attributeigenschaften/Texteigenschaften] übernehmen"
		)
	 )
	 (setq obj_list_a
		(mapcar
		  'cadr
		  (apply
		    'append
		    (mapcar
		      '(lambda (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
				       )
			       )
			     )
			   )
			    (vl-remove-if-not
			      '(lambda (att) (= (car att) att_name))
			      (mapcar
				'(lambda (obj)
				   (list
				     (vla-get-tagstring obj)
				     obj
				   )
				 )
				(vlax-invoke obj_name 'GetAttributes)
			      )
			    )
			 )
		       )
		      obj_list_i
		    )
		  )
		)
	 )
	 (setq obj_list_t
		(mapcar	'(lambda (obj)
			   (list obj (k_obj_midp obj))
			 )
			obj_list_t
		)
	 )
	 (setq obj_list_a
		(mapcar	'(lambda (obj)
			   (list obj (k_obj_midp obj))
			 )
			obj_list_a
		)
	 )
	 (while	(and obj_list_t obj_list_a)
	   (setq dummy
		  (car
		    (vl-sort
		      (apply
			'append
			(mapcar
			  '(lambda (obj_t)
			     (mapcar
			       '(lambda	(obj_a)
				  (list	(distance (cadr obj_t) (cadr obj_a))
					obj_t
					obj_a
				  )
				)
			       obj_list_a
			     )
			   )
			  obj_list_t
			)
		      )
		      '(lambda (q1 q2) (< (car q1) (car q2)))
		    )
		  )
	   )

;;; übernehmen
	   (txt-to-att (car (nth 1 dummy)) (car (nth 2 dummy)))
	   (setq obj_list_t (vl-remove (nth 1 dummy) obj_list_t))
	   (setq obj_list_a (vl-remove (nth 2 dummy) obj_list_a))
	   (vla-delete (car (nth 1 dummy)))
	 )
	)
	((and (= (length obj_list_i) 0)
	      (> (length obj_list_t) 0)
	 )
;;;       (print "Block zur Attributauswahl wählen")
	 (if (setq obj_name (car (k_satz->objlist
				   (k_ssget "Block zur Attributauswahl wählen"
					    (list (k_acbc ":E" ":S") '((0 . "INSERT") (66 . 1)))
				   )
				 )
			    )
	     )
	   (setq att_name
		  (k_auswahl_liste
		    (vl-sort
		      (k_purge_list
			(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
					 )
				 )
			    )
			  )
			   (mapcar
			     '(lambda (obj)
				(vla-get-tagstring obj)
			      )
			     (vlax-invoke obj_name 'GetAttributes)
			   )
			)
		      )
		      '<
		    )
		    "s"
		    "liste"
		    "Attribut wählen"
		    nil
		    nil
		  )
	   )
	 )
	 (initget "A T")
	 (setq attmove
		(getkword
		  "[Attributeigenschaften/Texteigenschaften] übernehmen"
		)
	 )

	 (foreach obj_t	obj_list_t
;;;Text markieren
	   (command "-pan"
		    (k_obj_midp obj_t)
		    (getvar "viewctr")
	   )
	   (command "_select"
		    (k_objlist->satz obj_t)
		    ""
	   )
	   (sssetfirst
	     (k_objlist->satz obj_t)
	     (k_objlist->satz obj_t)
	   )
;;; Block wählen
	   (setq ok nil)
	   (while (null ok)
	     (print "Block mit Attributen wählen")
	     (setq ent_name (k_entselp (punkt-owc 2)))
	     (if (or (not ent_name)
		     (=	(length
			  (l-conjunction (entget ent_name) '((0 . "INSERT") (66 . 1)))
			)
			2
		     )
		 )
	       (progn
		 (setq ok t)
		 (setq obj_name (k_->obj_name ent_name))
	       )
	     )
	   )

	   (if obj_name
;;; Zuweisen
	     (if (setq obj_a (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
					      )
				      )
				 )
			       )
				(cadr (car (vl-remove-if-not
					     '(lambda (att) (= (car att) att_name))
					     (mapcar
					       '(lambda	(obj)
						  (list
						    (vla-get-tagstring obj)
						    obj
						  )
						)
					       (vlax-invoke obj_name 'GetAttributes)
					     )
					   )
				      )
				)
			     )
		 )
	       (progn
		 (txt-to-att obj_t obj_a)
		 (vla-delete obj_t)
	       )
	     )
	   )
	 )
	)
      )
    )
  )
  (vla-endundomark (k_ac-doc))
  (princ)
)
;;; - ------------------------------------------------------------------------------ - ;
(princ
  (strcat
    "\nk_txt2att:  Texte in Attribute übertragen"
    "\n===========  "
    "\n(C) Andreas Kraus 2024 (info@kraus-cad.de)"
    "\nBefehlszeilenaufruf : k_txt2att\n"
  )
)
;;; - ------------------------------------------------------------------------------ - ;
(princ)