;;; - ------------------------------------------------------------------------------ - ;
;;; -                 T O O L - K_SYM2SCHEMA                                         - ;
;;; - ------------------------------------------------------------------------------ - ;
;;; - Beschreibung :  Blöcke importieren und schematisch anordnen                    - ;
;;; - ------------------------------------------------------------------------------ - ;
;;; - Befehle      :  k_sym2schema                                                   - ;
;;; - ------------------------------------------------------------------------------ - ;
;;; - letzte Änderung am : 03.11.2025                                                - ;
;;; -              durch : Andreas Kraus                                             - ;
;;; - ------------------------------------------------------------------------------ - ;

(DEFUN :M-ROUND	(#REAL)
  (COND	((= (QUOTE REAL) (TYPE #REAL))
	 (IF (<= 0.5 (ABS (REM #REAL 1)))
	   (IF (> #REAL 0)
	     (1+ (FIX #REAL))
	     (1- (FIX #REAL))
	   )
	   (FIX #REAL)
	 )
	)
	(#REAL)
  )
)
(DEFUN :M-ROUNDTOEVEN (#NUMLST)
  (MAPCAR (QUOTE (LAMBDA (N)
		   (IF (/= (REM N 1) 0.5)
		     (:M-ROUND N)
		     (PROGN (IF	(> N 0)
			      (* 2 (:M-ROUND (/ N 2)))
			      (* 2 (:M-ROUND (/ N 2)) -1)
			    )
		     )
		   )
		 )
	  )
	  #NUMLST
  )
)
(DEFUN COMPARE (E0 E1 /)
  (COND	((> (CAR E0) (CAR E1)) 1)
	((< (CAR E0) (CAR E1)) -1)
	((QUOTE T) 0)
  )
)
(DEFUN GATHER (LST LEN)
  (COND	((NULL LST) nil)
	((> (LENGTH LST) LEN)
	 (CONS (N-CAR LEN LST) (GATHER (N-CDR LEN LST) LEN))
	)
	((QUOTE SONST) (LIST LST))
  )
)
(DEFUN I-CDR (LST) (REVERSE (CDR (REVERSE LST))))
(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_3D->2D	(WERT / DUMMY)
  (IF (VL-EVERY	(QUOTE (LAMBDA (DUMMY) (= (TYPE DUMMY) (QUOTE LIST))))
		WERT
      )
    (MAPCAR (QUOTE (LAMBDA (DUMMY) (LIST (CAR DUMMY) (CADR DUMMY))))
	    WERT
    )
    (LIST (CAR WERT) (CADR WERT))
  )
)
(DEFUN K_AC-BEREICH nil
  (COND	((= (GETVAR "tilemode") 1)
	 (vla-get-ActiveLayout (K_AC-DOC))
	)
	((AND (= (GETVAR "tilemode") 0) (= (GETVAR "cvport") 1))
	 (vla-get-ActiveLayout (K_AC-DOC))
	)
	((AND (= (GETVAR "tilemode") 0) (> (GETVAR "cvport") 1))
	 (vla-Item (vla-get-Layouts (K_AC-DOC)) "model")
	)
  )
)
(DEFUN K_AC-DOC	nil
  (vla-get-ActiveDocument (vlax-get-acad-object))
)
(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)
    (SETQ VORAUSWAHL (L-CONJUNCTION VORAUSWAHL ANZEIGE_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_sym2schema.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_AUSWAHL_LISTE_SORT (LISTE	     /
			     AUSWAHL_LISTE_ID
			     DUMMY_LIST	     LISTE
			     LISTE_SORT	     LISTE_WAHL
			     OK_AUSWAHL_LISTE
			     SORTIERUNG	     TXT
			     ZEIG_LISTE	     ZEIG_LISTE_SORT
			    )
  (DEFUN END_AUSWAHL_LISTE (WERT)
    (SETQ OK_AUSWAHL_LISTE WERT)
    (DONE_DIALOG)
  )
  (DEFUN AUSWAHL_LISTE_IN nil
    (IF	LISTE_WAHL
      (IF (= SORTIERUNG "unten")
	(SETQ LISTE_SORT
	       (REVERSE
		 (CONS (NTH (ATOI (GET_TILE "liste")) LISTE_WAHL)
		       (REVERSE LISTE_SORT)
		 )
	       )
	)
	(SETQ LISTE_SORT
	       (CONS (NTH (ATOI (GET_TILE "liste")) LISTE_WAHL)
		     LISTE_SORT
	       )
	)
      )
    )
    (AUSWAHL_LISTE_SLISTE_SORT)
    (AUSWAHL_LISTE_SLISTE)
  )
  (DEFUN AUSWAHL_LISTE_OUT nil
    (IF	LISTE_SORT
      (SETQ LISTE_SORT
	     (VL-REMOVE
	       (NTH (ATOI (GET_TILE "liste_sort")) LISTE_SORT)
	       LISTE_SORT
	     )
      )
    )
    (AUSWAHL_LISTE_SLISTE_SORT)
    (AUSWAHL_LISTE_SLISTE)
  )
  (DEFUN AUSWAHL_LISTE_LISTE nil
    (IF	(= $REASON 4)
      (AUSWAHL_LISTE_IN)
    )
  )
  (DEFUN AUSWAHL_LISTE_LISTE_SORT nil
    (IF	(= $REASON 4)
      (AUSWAHL_LISTE_OUT)
    )
  )
  (DEFUN AUSWAHL_LISTE_SLISTE nil
    (SETQ LISTE_WAHL LISTE)
    (FOREACH WAHL LISTE_SORT
      (SETQ LISTE_WAHL (VL-REMOVE WAHL LISTE_WAHL))
    )
    (SETQ ZEIG_LISTE
	   (MAPCAR
	     (QUOTE
	       (LAMBDA (TXT)
		 (SUBSTR TXT (1+ (ATOI (GET_TILE "slide_liste"))))
	       )
	     )
	     LISTE_WAHL
	   )
    )
    (START_LIST "liste")
    (MAPCAR (QUOTE ADD_LIST) ZEIG_LISTE)
    (END_LIST)
  )
  (DEFUN AUSWAHL_LISTE_SLISTE_SORT nil
    (SETQ ZEIG_LISTE_SORT
	   (MAPCAR
	     (QUOTE
	       (LAMBDA (TXT)
		 (SUBSTR
		   TXT
		   (1+ (ATOI (GET_TILE "slide_liste_sort")))
		 )
	       )
	     )
	     LISTE_SORT
	   )
    )
    (START_LIST "liste_sort")
    (MAPCAR (QUOTE ADD_LIST) ZEIG_LISTE_SORT)
    (END_LIST)
  )
  (DEFUN AUSWAHL_LISTE_OBEN nil
    (IF	(= SORTIERUNG "unten")
      (SETQ LISTE_SORT (REVERSE LISTE_SORT))
    )
    (SETQ SORTIERUNG "oben")
    (AUSWAHL_LISTE_SLISTE_SORT)
    (AUSWAHL_LISTE_OBEN-UNTEN)
  )
  (DEFUN AUSWAHL_LISTE_UNTEN nil
    (IF	(= SORTIERUNG "oben")
      (SETQ LISTE_SORT (REVERSE LISTE_SORT))
    )
    (SETQ SORTIERUNG "unten")
    (AUSWAHL_LISTE_SLISTE_SORT)
    (AUSWAHL_LISTE_OBEN-UNTEN)
  )
  (DEFUN AUSWAHL_LISTE_OBEN-UNTEN nil
    (K_DRAW_IMAGE
      "oben"
      (LIST (LIST "fill"
		  (LIST	"color"
			(IF (= SORTIERUNG "oben")
			  3
			  -15
			)
		  )
	    )
	    (QUOTE ("arrow" ("start" (50 90))
			    ("end" (50 10))
			    ("color" 0)
			    ("size" 5)
			    ("ratio" 1.0)
		   )
	    )
      )
    )
    (K_DRAW_IMAGE
      "unten"
      (LIST (LIST "fill"
		  (LIST	"color"
			(IF (= SORTIERUNG "unten")
			  3
			  -15
			)
		  )
	    )
	    (QUOTE ("arrow" ("start" (50 10))
			    ("end" (50 90))
			    ("color" 0)
			    ("size" 5)
			    ("ratio" 1.0)
		   )
	    )
      )
    )
  )
  (SETQ AUSWAHL_LISTE_ID (LOAD_DIALOG "k_sym2schema.dcl"))
  (IF (NOT (NEW_DIALOG "k_auswahl_liste_sort" AUSWAHL_LISTE_ID))
    (EXIT)
  )
  (AUSWAHL_LISTE_SLISTE)
  (START_LIST "liste_sort")
  (MAPCAR (QUOTE ADD_LIST) LISTE_SORT)
  (END_LIST)
  (ACTION_TILE "accept" "(end_auswahl_liste 1)")
  (ACTION_TILE "cancel" "(end_auswahl_liste 0)")
  (ACTION_TILE "in" "(auswahl_liste_in)")
  (ACTION_TILE "out" "(auswahl_liste_out)")
  (ACTION_TILE "liste" "(auswahl_liste_liste)")
  (ACTION_TILE "liste_sort" "(auswahl_liste_liste_sort)")
  (ACTION_TILE "slide_liste" "(auswahl_liste_sliste)")
  (ACTION_TILE "oben" "(auswahl_liste_oben)")
  (ACTION_TILE "unten" "(auswahl_liste_unten)")
  (ACTION_TILE
    "slide_liste_sort"
    "(auswahl_liste_sliste_sort)"
  )
  (K_DRAW_IMAGE
    "in"
    (LIST (QUOTE ("fill" ("color" -15)))
	  (QUOTE ("arrow" ("start" (20 50))
			  ("end" (80 50))
			  ("color" 0)
			  ("size" 5)
			  ("ratio" 0.5)
		 )
	  )
    )
  )
  (K_DRAW_IMAGE
    "out"
    (LIST (QUOTE ("fill" ("color" -15)))
	  (QUOTE ("arrow" ("start" (80 50))
			  ("end" (20 50))
			  ("color" 0)
			  ("size" 5)
			  ("ratio" 0.5)
		 )
	  )
    )
  )
  (SETQ SORTIERUNG "oben")
  (AUSWAHL_LISTE_OBEN-UNTEN)
  (START_DIALOG)
  (UNLOAD_DIALOG AUSWAHL_LISTE_ID)
  (SETQ DUMMY_LIST (LIST))
  (IF (= OK_AUSWAHL_LISTE 1)
    (REVERSE LISTE_SORT)
    nil
  )
)
(DEFUN K_BIT (WERT BIT) (= (LOGAND WERT BIT) BIT))
(DEFUN K_CHECK_ASSOC (GRUPPE LISTE ALTERNATIV / DATA)
  (SETQ	LISTE
	 (MAPCAR (QUOTE	(LAMBDA	(DATA)
			  (CONS	(IF (= (TYPE (CAR DATA)) (QUOTE LIST))
				  (CAAR DATA)
				  (CAR DATA)
				)
				(CDR DATA)
			  )
			)
		 )
		 LISTE
	 )
  )
  (AND (ASSOC GRUPPE LISTE)
       (NOT (ATOM (SETQ DATA (CDR (ASSOC GRUPPE LISTE)))))
  )
  (SETQ
    DATA (COND ((NOT (LISTP DATA)) DATA)
	       ((AND (LISTP DATA) (= (LENGTH DATA) 1)) (NTH 0 DATA))
	       ((AND (LISTP DATA) (> (LENGTH DATA) 1)) DATA)
	       (T ALTERNATIV)
	 )
  )
)
(DEFUN K_CHECK_NEU_INI (PFAD_1	     PFAD_2	  /
			DATA	     EDIT_EINTRAG EINTRAG
			EINTRAG_BEZ  INI_LIST_1	  INI_LIST_2
		       )
  (IF (FINDFILE PFAD_1)
    (PROGN
      (SETQ INI_LIST_1 (K_LOAD PFAD_1))
      (IF (FINDFILE PFAD_2)
	(PROGN
	  (SETQ INI_LIST_2 (K_LOAD PFAD_2))
	  (FOREACH EINTRAG INI_LIST_1
	    (IF
	      (NOT
		(MEMBER
		  (CAR
		    (MAPCAR (QUOTE (LAMBDA (DATA)
				     (WHILE (= (TYPE DATA) (QUOTE LIST))
				       (SETQ DATA (CAR DATA))
				     )
				     DATA
				   )
			    )
			    EINTRAG
		    )
		  )
		  (MAPCAR (QUOTE (LAMBDA (DATA)
				   (WHILE (= (TYPE DATA) (QUOTE LIST))
				     (SETQ DATA (CAR DATA))
				   )
				   DATA
				 )
			  )
			  INI_LIST_2
		  )
		)
	      )
	       (SETQ INI_LIST_2 (APPEND INI_LIST_2 (LIST EINTRAG)))
	       (PROGN (SETQ EINTRAG_BEZ
			     (IF (= (TYPE (CAR EINTRAG)) (QUOTE LIST))
			       (CAAR EINTRAG)
			       (CAR EINTRAG)
			     )
		      )
		      (SETQ INI_LIST_2
			     (MAPCAR
			       (QUOTE
				 (LAMBDA (DATA)
				   (IF (EQUAL EINTRAG_BEZ
					      (IF (= (TYPE (CAR DATA))
						     (QUOTE LIST)
						  )
						(CAAR DATA)
						(CAR DATA)
					      )
				       )
				     (PROGN
				       (IF
					 (> (IF	(= (TYPE (CAR EINTRAG))
						   (QUOTE LIST)
						)
					      (VL-PRINC-TO-STRING
						(CADAR EINTRAG)
					      )
					      "0"
					    )
					    (IF	(= (TYPE (CAR DATA))
						   (QUOTE LIST)
						)
					      (VL-PRINC-TO-STRING
						(CADAR DATA)
					      )
					      "0"
					    )
					 )
					  (SETQ DATA EINTRAG)
				       )
				     )
				   )
				   DATA
				 )
			       )
			       INI_LIST_2
			     )
		      )
	       )
	    )
	  )
	  (K_PRINT_DATEI PFAD_2 INI_LIST_2)
	)
	(K_PRINT_DATEI PFAD_2 INI_LIST_1)
      )
    )
  )
  INI_LIST_2
)
(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_DIALOG	(TODO TXT1 TXT2)
  (DEFUN K_COUNTER_DIALOG_NEU nil
    (DONE_DIALOG)
    (NEW_DIALOG "k_counter_dialog" 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_sym2schema.dcl")
	       K_COUNTER_DIALOG_N 0
	       K_COUNTER_DIALOG_TITEL TXT1
	 )
	 (COND ((AND TXT2 (= (TYPE TXT1) (QUOTE INT)))
		(SETQ K_COUNTER_DIALOG_X TXT2)
	       )
	       ((AND TXT2 (= (TYPE TXT1) (QUOTE STR)))
		(SETQ K_COUNTER_DIALOG_T TXT2)
	       )
	       (T (SETQ K_COUNTER_DIALOG_X nil))
	 )
	 (IF (NOT (NEW_DIALOG "k_counter_dialog" K_COUNTER_DLG))
	   (EXIT)
	 )
	 (IF K_COUNTER_DIALOG_TITEL
	   (SET_TILE "titel"
		     (VL-PRINC-TO-STRING K_COUNTER_DIALOG_TITEL)
	   )
	 )
	)
	((AND (= (TYPE TODO) (QUOTE STR)) (= (STRCASE TODO) "END"))
	 (DONE_DIALOG)
	 (IF K_COUNTER_DLG
	   (UNLOAD_DIALOG K_COUNTER_DLG)
	 )
	 (SETQ K_COUNTER_DIALOG_N nil
	       K_COUNTER_DLG nil
	 )
	)
	((AND (= (TYPE TODO) (QUOTE STR)) (= (STRCASE TODO) "SHOW"))
	 (SETQ K_COUNTER_DIALOG_N (1+ K_COUNTER_DIALOG_N))
	 (IF (AND K_COUNTER_DIALOG_X
		  (>= K_COUNTER_DIALOG_N K_COUNTER_DIALOG_X)
	     )
	   (K_COUNTER_DIALOG_NEU)
	 )
	 (SET_TILE "text1" (VL-PRINC-TO-STRING TXT1))
	 (SET_TILE "text2" (VL-PRINC-TO-STRING TXT2))
	)
	(T nil)
  )
)
(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_sym2schema.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_CUT_PFADLAST (PFAD / PFAD_LIST DUMMY_LIST)
  (WHILE (NOT
	   (EQUAL PFAD (SETQ DUMMY (VL-STRING-SUBST "/" "\\" PFAD)))
	 )
    (SETQ PFAD DUMMY)
  )
  (SETQ	PFAD_LIST
	 (REVERSE
	   (CDR
	     (REVERSE (VL-REMOVE "" (K_ZERLEGE_ART PFAD "/" "STR"))
	     )
	   )
	 )
  )
  (SETQ PFAD "")
  (FOREACH DUMMY PFAD_LIST
    (SETQ PFAD (STRCAT PFAD DUMMY "/"))
  )
  (IF (= PFAD "")
    (PROGN (FOREACH DUMMY DUMMY_LIST
	     (SETQ PFAD (STRCAT PFAD DUMMY "/"))
	   )
    )
  )
  (SETQ PFAD PFAD)
)
(DEFUN K_DATA->PROP (PROP DATA)
  (SETQ DATA (VL-PRINC-TO-STRING DATA))
  (COND	((= (vlax-variant-type (vla-get-Value PROP)) 5)
	 (vla-put-Value
	   PROP
	   (vlax-make-variant
	     (ATOF DATA)
	     (vlax-variant-type (vla-get-Value PROP))
	   )
	 )
	)
	((= (vlax-variant-type (vla-get-Value PROP)) 4)
	 (vla-put-Value
	   PROP
	   (vlax-make-variant
	     (ATOF DATA)
	     (vlax-variant-type (vla-get-Value PROP))
	   )
	 )
	)
	((= (vlax-variant-type (vla-get-Value PROP)) 2)
	 (IF (NOT (MINUSP (ATOI DATA)))
	   (vla-put-Value
	     PROP
	     (vlax-make-variant
	       (ATOI DATA)
	       (vlax-variant-type (vla-get-Value PROP))
	     )
	   )
	 )
	)
	((= (vlax-variant-type (vla-get-Value PROP)) 3)
	 (vla-put-Value
	   PROP
	   (vlax-make-variant
	     (ATOI DATA)
	     (vlax-variant-type (vla-get-Value PROP))
	   )
	 )
	)
	((= (vlax-variant-type (vla-get-Value PROP)) 8)
	 (vla-put-Value
	   PROP
	   (vlax-make-variant
	     (ATOI DATA)
	     (vlax-variant-type (vla-get-Value PROP))
	   )
	 )
	)
	((vla-put-Value
	   PROP
	   (vlax-make-variant
	     DATA
	     (vlax-variant-type (vla-get-Value PROP))
	   )
	 )
	)
  )
)
(DEFUN K_DATA->PROPERTY-CONVERT	(OBJ_NAME BEZ DATA / PROP_TYPE)
  (SETQ PROP_TYPE (TYPE (K_GET_DATA OBJ_NAME BEZ nil nil)))
  (IF (= PROP_TYPE (TYPE DATA))
    DATA
    (COND ((= PROP_TYPE (QUOTE INT)) (ATOI (VL-PRINC-TO-STRING DATA)))
	  ((= PROP_TYPE (QUOTE REAL))
	   (ATOF (VL-PRINC-TO-STRING DATA))
	  )
	  ((= PROP_TYPE (QUOTE STR)) (VL-PRINC-TO-STRING DATA))
	  ((= PROP_TYPE (QUOTE LIST))
	   (IF (= (TYPE (READ DATA)) (QUOTE LIST))
	     (READ DATA)
	   )
	  )
    )
  )
)
(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_DRAW_IMAGE (IMAGE_NAME	       DATA_LIST	 /
		     ART      B	       BREITE	C	 CENTER
		     CHR_LIST COLOR    C_LIST	DATA	 DUMMY
		     DUMMY_LIST	       DX	DY	 END
		     FONT_LIST	       H	HEIGHT	 HOEHE
		     MAX-X    MAX-Y    MIN-X	MIN-Y	 P
		     P1	      P2       P3	P4	 PL
		     PLIST    POS      POSITION	P_LIST	 RADIUS
		     RATIO    RICHTUNG SIZE	START	 TEMP_LIST
		     TEXT     W	       WIDTH	WINKEL	 W_LIST
		     X-LIST   Y-LIST   Z
		    )
  (SETQ	FONT_LIST
	 (QUOTE
	   ((" " ((1 0.0 0.0) (2 0.5 0.0)))
	     ("³" ((1 0.0 0.17)
		    (1 0.17 0.0)
		    (1 0.33 0.0)
		    (1 0.5 0.17)
		    (1 0.5 0.33)
		    (1 0.33 0.5)
		    (1 0.33 0.67)
		    (0 0 0)
		    (1 0.33 0.83)
		    (1 0.33 1.0)
		    (2 0.6 0.0)
		  )
	     )
	     ("²" ((1 0.0 0.17)
		    (1 0.17 0.0)
		    (1 0.33 0.0)
		    (1 0.5 0.17)
		    (1 0.5 0.33)
		    (1 0.33 0.5)
		    (1 0.33 0.67)
		    (0 0 0)
		    (1 0.33 0.83)
		    (1 0.33 1.0)
		    (2 0.6 0.0)
		  )
	     )
	     ("]" ((1 0.0 0.0)
		    (1 0.33 0.0)
		    (1 0.33 1.0)
		    (1 0.0 1.0)
		    (2 0.43 0.0)
		  )
	     )
	     ("[" ((1 0.33 1.0)
		    (1 0.0 1.0)
		    (1 0.0 0.0)
		    (1 0.33 0.0)
		    (2 0.43 0.0)
		  )
	     )
	     ("}" ((1 0.0 1.0)
		    (1 0.17 0.83)
		    (1 0.17 0.67)
		    (1 0.33 0.5)
		    (1 0.17 0.33)
		    (1 0.17 0.17)
		    (1 0.0 0.0)
		    (2 0.43 0.0)
		  )
	     )
	     ("{" ((1 0.33 0.0)
		    (1 0.17 0.17)
		    (1 0.17 0.33)
		    (1 0.0 0.5)
		    (1 0.17 0.67)
		    (1 0.17 0.83)
		    (1 0.33 1.0)
		    (2 0.43 0.0)
		  )
	     )
	     ("°" ((1 0.17 0.0)
		    (1 0.33 0.17)
		    (1 0.17 0.33)
		    (1 0.0 0.17)
		    (2 0.43 0.0)
		  )
	     )
	     ("^" ((1 0.0 0.33)
		    (1 0.33 0.0)
		    (1 0.67 0.33)
		    (2 0.77 0.0)
		  )
	     )
	     ("+" ((1 0.33 0.83)
		    (1 0.33 0.17)
		    (0 0 0)
		    (1 0.67 0.5)
		    (1 0.0 0.5)
		    (2 0.77 0.0)
		  )
	     )
	     ("*" ((1 0.33 0.83)
		    (1 0.33 0.17)
		    (0 0 0)
		    (1 0.67 0.5)
		    (1 0.0 0.5)
		    (0 0 0)
		    (1 0.67 0.17)
		    (1 0.0 0.83)
		    (0 0 0)
		    (1 0.0 0.17)
		    (1 0.67 0.83)
		    (2 0.77 0.0)
		  )
	     )
	     ("#" ((1 0.0 0.67)
		    (1 0.67 0.67)
		    (0 0 0)
		    (1 0.67 0.33)
		    (1 0.0 0.33)
		    (0 0 0)
		    (1 0.17 0.0)
		    (1 0.17 1.0)
		    (0 0 0)
		    (1 0.5 1.0)
		    (1 0.5 0.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("'" ((1 0.0 0.33) (1 0.17 0.0) (2 0.27 0.0)))
	     (">" ((1 0.0 0.0) (1 0.5 0.5) (1 0.0 1.0) (2 0.6 0.0))
	     )
	     ("<" ((1 0.5 0.0) (1 0.0 0.5) (1 0.5 1.0) (2 0.6 0.0))
	     )
	     ("_" ((1 0.0 1.17) (1 0.67 1.17) (2 0.77 0.0)))
	     (":" ((1 0.0 0.33)
		    (1 0.0 0.5)
		    (0 0 0)
		    (1 0.0 0.67)
		    (1 0.0 0.83)
		    (2 0.1 0.0)
		  )
	     )
	     (";" ((1 0.17 0.33)
		    (1 0.17 0.5)
		    (0 0 0)
		    (1 0.17 0.67)
		    (1 0.17 1.0)
		    (1 0.0 1.17)
		    (2 0.27 0.0)
		  )
	     )
	     ("-" ((1 0.0 0.5) (1 0.67 0.5) (2 0.77 0.0)))
	     ("." ((1 0.0 1.0) (1 0.0 0.83) (2 0.1 0.0)))
	     ("," ((1 0.17 0.83)
		    (1 0.17 1.0)
		    (1 0.0 1.17)
		    (2 0.27 0.0)
		  )
	     )
	     ("?" ((1 0.0 0.17)
		    (1 0.17 0.0)
		    (1 0.33 0.0)
		    (1 0.5 0.17)
		    (1 0.5 0.33)
		    (1 0.33 0.5)
		    (1 0.33 0.67)
		    (0 0 0)
		    (1 0.33 0.83)
		    (1 0.33 1.0)
		    (2 0.6 0.0)
		  )
	     )
	     ("=" ((1 0.0 0.33)
		    (1 0.67 0.33)
		    (0 0 0)
		    (1 0.67 0.67)
		    (1 0.0 0.67)
		    (2 0.77 0.0)
		  )
	     )
	     (")" ((1 0.0 0.0)
		    (1 0.33 0.33)
		    (1 0.33 0.67)
		    (1 0.0 1.0)
		    (2 0.43 0.0)
		  )
	     )
	     ("(" ((1 0.33 0.0)
		    (1 0.0 0.33)
		    (1 0.0 0.67)
		    (1 0.33 1.0)
		    (2 0.43 0.0)
		  )
	     )
	     ("/" ((1 0.0 1.0) (1 0.67 0.0) (2 0.77 0.0)))
	     ("&" ((1 0.67 0.67)
		    (1 0.33 1.0)
		    (1 0.17 1.0)
		    (1 0.0 0.83)
		    (1 0.0 0.67)
		    (1 0.33 0.33)
		    (1 0.33 0.17)
		    (1 0.17 0.0)
		    (1 0.0 0.17)
		    (1 0.0 0.33)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("%" ((1 0.0 0.17)
		    (1 0.17 0.17)
		    (1 0.17 0.0)
		    (1 0.0 0.0)
		    (0 0 0)
		    (1 0.67 0.0)
		    (1 0.0 1.0)
		    (0 0 0)
		    (1 0.5 1.0)
		    (1 0.5 0.83)
		    (1 0.67 0.83)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("$" ((1 0.0 0.83)
		    (1 0.5 0.83)
		    (1 0.67 0.67)
		    (1 0.5 0.5)
		    (1 0.17 0.5)
		    (1 0.0 0.33)
		    (1 0.17 0.17)
		    (1 0.67 0.17)
		    (0 0 0)
		    (1 0.33 0.0)
		    (1 0.33 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("§" ((1 0.0 0.83)
		    (1 0.17 1.0)
		    (1 0.33 1.0)
		    (1 0.5 0.83)
		    (1 0.33 0.67)
		    (0 0 0)
		    (1 0.5 0.17)
		    (1 0.33 0.0)
		    (1 0.17 0.0)
		    (1 0.0 0.17)
		    (1 0.17 0.33)
		    (1 0.33 0.33)
		    (1 0.5 0.5)
		    (1 0.33 0.67)
		    (1 0.17 0.67)
		    (1 0.0 0.5)
		    (1 0.17 0.33)
		    (2 0.6 0.0)
		  )
	     )
	     ("\"" ((1 0.0 0.33)
		     (1 0.17 0.0)
		     (0 0 0)
		     (1 0.33 0.0)
		     (1 0.17 0.33)
		     (2 0.43 0.0)
		   )
	     )
	     ("!" ((1 0.0 1.0)
		    (1 0.0 0.83)
		    (0 0 0)
		    (1 0.0 0.67)
		    (1 0.0 0.0)
		    (2 0.1 0.0)
		  )
	     )
	     ("ß" ((1 0.0 1.0)
		    (1 0.17 0.83)
		    (1 0.17 0.17)
		    (1 0.33 0.0)
		    (1 0.5 0.0)
		    (1 0.67 0.17)
		    (1 0.67 0.33)
		    (1 0.5 0.5)
		    (1 0.67 0.67)
		    (1 0.67 0.83)
		    (1 0.5 1.0)
		    (1 0.33 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("Ü" ((1 0.0 0.0)
		    (1 0.0 0.83)
		    (1 0.17 1.0)
		    (1 0.5 1.0)
		    (1 0.67 0.83)
		    (1 0.67 0.0)
		    (0 0 0)
		    (1 0.5 0.17)
		    (1 0.5 0.0)
		    (0 0 0)
		    (1 0.17 0.0)
		    (1 0.17 0.17)
		    (2 0.77 0.0)
		  )
	     )
	     ("Ö" ((1 0.17 0.17)
		    (1 0.17 0.0)
		    (0 0 0)
		    (1 0.5 0.17)
		    (1 0.5 0.0)
		    (0 0 0)
		    (1 0.0 0.2)
		    (1 0.67 0.2)
		    (1 0.67 1.0)
		    (1 0.0 1.0)
		    (1 0.0 0.2)
		    (2 0.77 0.0)
		  )
	     )
	     ("Ä" ((1 0.0 1.0)
		    (1 0.0 0.67)
		    (0 0 0)
		    (1 0.0 0.17)
		    (1 0.0 0.0)
		    (0 0 0)
		    (1 0.67 0.0)
		    (1 0.67 0.17)
		    (0 0 0)
		    (1 0.67 0.67)
		    (1 0.33 0.0)
		    (1 0.0 0.67)
		    (1 0.67 0.67)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("ü" ((1 0.17 0.0)
		    (1 0.17 0.17)
		    (0 0 0)
		    (1 0.0 0.33)
		    (1 0.0 0.83)
		    (1 0.17 1.0)
		    (1 0.33 1.0)
		    (1 0.67 0.67)
		    (0 0 0)
		    (1 0.5 0.0)
		    (1 0.5 0.17)
		    (0 0 0)
		    (1 0.67 0.33)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("ö" ((1 0.0 0.0)
		    (1 0.0 0.17)
		    (0 0 0)
		    (1 0.67 0.17)
		    (1 0.67 0.0)
		    (0 0 0)
		    (1 0.17 1.0)
		    (1 0.0 0.83)
		    (1 0.0 0.5)
		    (1 0.17 0.33)
		    (1 0.5 0.33)
		    (1 0.67 0.5)
		    (1 0.67 0.83)
		    (1 0.5 1.0)
		    (1 0.17 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("ä" ((1 0.0 0.0)
		    (1 0.0 0.17)
		    (0 0 0)
		    (1 0.5 0.17)
		    (1 0.5 0.0)
		    (0 0 0)
		    (1 0.5 0.83)
		    (1 0.5 0.5)
		    (1 0.33 0.33)
		    (1 0.17 0.33)
		    (1 0.0 0.5)
		    (1 0.0 0.83)
		    (1 0.17 1.0)
		    (1 0.33 1.0)
		    (1 0.5 0.83)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("Z" ((1 0.0 0.0)
		    (1 0.67 0.0)
		    (1 0.0 1.0)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("Y" ((1 0.0 0.0)
		    (1 0.33 0.5)
		    (0 0 0)
		    (1 0.33 1.0)
		    (1 0.33 0.5)
		    (1 0.67 0.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("X" ((1 0.0 1.0)
		    (1 0.67 0.0)
		    (0 0 0)
		    (1 0.0 0.0)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("W" ((1 0.0 0.0)
		    (1 0.33 1.0)
		    (1 0.5 0.5)
		    (1 0.67 1.0)
		    (1 1.0 0.0)
		    (2 1.1 0.0)
		  )
	     )
	     ("V" ((1 0.0 0.0) (1 0.5 1.0) (1 1.0 0.0) (2 1.1 0.0))
	     )
	     ("U" ((1 0.0 0.0)
		    (1 0.0 0.83)
		    (1 0.17 1.0)
		    (1 0.5 1.0)
		    (1 0.67 0.83)
		    (1 0.67 0.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("T" ((1 0.0 0.0)
		    (1 0.67 0.0)
		    (0 0 0)
		    (1 0.33 0.0)
		    (1 0.33 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("S" ((1 0.0 0.83)
		    (1 0.17 1.0)
		    (1 0.5 1.0)
		    (1 0.67 0.83)
		    (1 0.0 0.17)
		    (1 0.17 0.0)
		    (1 0.5 0.0)
		    (1 0.67 0.17)
		    (2 0.77 0.0)
		  )
	     )
	     ("R" ((1 0.0 1.0)
		    (1 0.0 0.0)
		    (1 0.5 0.0)
		    (1 0.67 0.17)
		    (1 0.67 0.33)
		    (1 0.5 0.5)
		    (1 0.0 0.5)
		    (0 0 0)
		    (1 0.17 0.5)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("Q" ((1 0.33 0.67)
		    (1 0.5 0.83)
		    (1 0.33 1.0)
		    (1 0.17 1.0)
		    (1 0.0 0.83)
		    (1 0.0 0.17)
		    (1 0.17 0.0)
		    (1 0.5 0.0)
		    (1 0.67 0.17)
		    (1 0.67 0.67)
		    (1 0.5 0.83)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("P" ((1 0.0 1.0)
		    (1 0.0 0.0)
		    (1 0.5 0.0)
		    (1 0.67 0.17)
		    (1 0.67 0.33)
		    (1 0.5 0.5)
		    (1 0.0 0.5)
		    (2 0.77 0.0)
		  )
	     )
	     ("O" ((1 0.0 0.0)
		    (1 0.67 0.0)
		    (1 0.67 1.0)
		    (1 0.0 1.0)
		    (1 0.0 0.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("N" ((1 0.0 1.0)
		    (1 0.0 0.0)
		    (1 0.67 1.0)
		    (1 0.67 0.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("M" ((1 0.0 1.0)
		    (1 0.0 0.0)
		    (1 0.33 0.67)
		    (1 0.67 0.0)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("L"
	       ((1 0.0 0.0) (1 0.0 1.0) (1 0.67 1.0) (2 0.77 0.0))
	     )
	     ("K" ((1 0.0 1.0)
		    (1 0.0 0.0)
		    (0 0 0)
		    (1 0.67 0.0)
		    (1 0.17 0.5)
		    (0 0 0)
		    (1 0.0 0.5)
		    (1 0.17 0.5)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("J" ((1 0.0 0.83)
		    (1 0.17 1.0)
		    (1 0.5 1.0)
		    (1 0.67 0.83)
		    (1 0.67 0.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("I" ((1 0.0 0.0)
		    (1 0.33 0.0)
		    (0 0 0)
		    (1 0.17 0.0)
		    (1 0.17 1.0)
		    (0 0 0)
		    (1 0.0 1.0)
		    (1 0.33 1.0)
		    (2 0.43 0.0)
		  )
	     )
	     ("H" ((1 0.0 1.0)
		    (1 0.0 0.0)
		    (0 0 0)
		    (1 0.0 0.5)
		    (1 0.67 0.5)
		    (0 0 0)
		    (1 0.67 0.0)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("G" ((1 0.5 0.5)
		    (1 0.67 0.5)
		    (1 0.67 1.0)
		    (1 0.17 1.0)
		    (1 0.0 0.83)
		    (1 0.0 0.17)
		    (1 0.17 0.0)
		    (1 0.67 0.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("F" ((1 0.0 1.0)
		    (1 0.0 0.0)
		    (1 0.67 0.0)
		    (0 0 0)
		    (1 0.0 0.5)
		    (1 0.33 0.5)
		    (2 0.77 0.0)
		  )
	     )
	     ("E" ((1 0.0 0.5)
		    (1 0.33 0.5)
		    (0 0 0)
		    (1 0.67 0.0)
		    (1 0.0 0.0)
		    (1 0.0 1.0)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("D" ((1 0.0 1.0)
		    (1 0.5 1.0)
		    (1 0.67 0.83)
		    (1 0.67 0.17)
		    (1 0.5 0.0)
		    (1 0.0 0.0)
		    (0 0 0)
		    (1 0.17 0.0)
		    (1 0.17 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("C" ((1 0.67 0.83)
		    (1 0.5 1.0)
		    (1 0.17 1.0)
		    (1 0.0 0.83)
		    (1 0.0 0.17)
		    (1 0.17 0.0)
		    (1 0.5 0.0)
		    (1 0.67 0.17)
		    (2 0.77 0.0)
		  )
	     )
	     ("B" ((1 0.0 1.0)
		    (1 0.5 1.0)
		    (1 0.67 0.83)
		    (1 0.67 0.67)
		    (1 0.5 0.5)
		    (0 0 0)
		    (1 0.17 0.5)
		    (1 0.5 0.5)
		    (1 0.67 0.33)
		    (1 0.67 0.17)
		    (1 0.5 0.0)
		    (1 0.0 0.0)
		    (0 0 0)
		    (1 0.17 0.0)
		    (1 0.17 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("A" ((1 0.0 1.0)
		    (1 0.0 0.67)
		    (0 0 0)
		    (1 0.67 0.67)
		    (1 0.33 0.0)
		    (1 0.0 0.67)
		    (1 0.67 0.67)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("z" ((1 0.0 0.33)
		    (1 0.67 0.33)
		    (1 0.0 1.0)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("y" ((1 0.0 0.33)
		    (1 0.33 1.0)
		    (0 0 0)
		    (1 0.67 0.33)
		    (1 0.17 1.33)
		    (1 0.0 1.33)
		    (2 0.77 0.0)
		  )
	     )
	     ("x" ((1 0.0 1.0)
		    (1 0.67 0.33)
		    (0 0 0)
		    (1 0.0 0.33)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("w" ((1 0.0 0.33)
		    (1 0.17 1.0)
		    (1 0.33 0.33)
		    (1 0.5 1.0)
		    (1 0.67 0.33)
		    (2 0.77 0.0)
		  )
	     )
	     ("v" ((1 0.0 0.33)
		    (1 0.33 1.0)
		    (1 0.67 0.33)
		    (2 0.77 0.0)
		  )
	     )
	     ("u" ((1 0.0 0.33)
		    (1 0.0 0.83)
		    (1 0.17 1.0)
		    (1 0.33 1.0)
		    (1 0.67 0.67)
		    (0 0 0)
		    (1 0.67 0.33)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("t" ((1 0.0 0.33)
		    (1 0.67 0.33)
		    (0 0 0)
		    (1 0.33 0.0)
		    (1 0.33 0.83)
		    (1 0.5 1.0)
		    (1 0.67 0.83)
		    (2 0.77 0.0)
		  )
	     )
	     ("s" ((1 0.0 1.0)
		    (1 0.5 1.0)
		    (1 0.67 0.83)
		    (1 0.5 0.67)
		    (1 0.17 0.67)
		    (1 0.0 0.5)
		    (1 0.17 0.33)
		    (1 0.67 0.33)
		    (2 0.77 0.0)
		  )
	     )
	     ("r" ((1 0.0 1.0)
		    (1 0.0 0.33)
		    (0 0 0)
		    (1 0.0 0.67)
		    (1 0.33 0.33)
		    (1 0.5 0.33)
		    (1 0.67 0.5)
		    (2 0.77 0.0)
		  )
	     )
	     ("q" ((1 0.67 1.33)
		    (1 0.67 0.33)
		    (0 0 0)
		    (1 0.67 0.5)
		    (1 0.5 0.33)
		    (1 0.17 0.33)
		    (1 0.0 0.5)
		    (1 0.0 0.83)
		    (1 0.17 1.0)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("p" ((1 0.0 1.33)
		    (1 0.0 0.33)
		    (0 0 0)
		    (1 0.0 0.5)
		    (1 0.17 0.33)
		    (1 0.5 0.33)
		    (1 0.67 0.5)
		    (1 0.67 0.83)
		    (1 0.5 1.0)
		    (1 0.0 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("o" ((1 0.17 1.0)
		    (1 0.0 0.83)
		    (1 0.0 0.5)
		    (1 0.17 0.33)
		    (1 0.5 0.33)
		    (1 0.67 0.5)
		    (1 0.67 0.83)
		    (1 0.5 1.0)
		    (1 0.17 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("n" ((1 0.0 1.0)
		    (1 0.0 0.33)
		    (0 0 0)
		    (1 0.0 0.67)
		    (1 0.33 0.33)
		    (1 0.5 0.33)
		    (1 0.67 0.5)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("m" ((1 0.0 1.0)
		    (1 0.0 0.33)
		    (0 0 0)
		    (1 0.0 0.5)
		    (1 0.17 0.33)
		    (1 0.33 0.5)
		    (0 0 0)
		    (1 0.33 0.67)
		    (1 0.33 0.5)
		    (1 0.5 0.33)
		    (1 0.67 0.5)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("l"
	       ((1 0.0 0.0) (1 0.0 0.83) (1 0.17 1.0) (2 0.27 0.0))
	     )
	     ("k" ((1 0.0 1.0)
		    (1 0.0 0.0)
		    (0 0 0)
		    (1 0.0 0.67)
		    (1 0.33 0.67)
		    (0 0 0)
		    (1 0.67 0.33)
		    (1 0.33 0.67)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("j" ((1 0.0 1.17)
		    (1 0.17 1.33)
		    (1 0.33 1.33)
		    (1 0.5 1.17)
		    (1 0.5 0.33)
		    (0 0 0)
		    (1 0.5 0.17)
		    (1 0.5 0.0)
		    (2 0.6 0.0)
		  )
	     )
	     ("i" ((1 0.0 1.0)
		    (1 0.0 0.33)
		    (0 0 0)
		    (1 0.0 0.17)
		    (1 0.0 0.0)
		    (2 0.1 0.0)
		  )
	     )
	     ("h" ((1 0.0 1.0)
		    (1 0.0 0.0)
		    (0 0 0)
		    (1 0.0 0.67)
		    (1 0.33 0.33)
		    (1 0.5 0.33)
		    (1 0.67 0.5)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("g" ((1 0.0 1.17)
		    (1 0.17 1.33)
		    (1 0.5 1.33)
		    (1 0.67 1.17)
		    (1 0.67 0.5)
		    (1 0.5 0.33)
		    (1 0.17 0.33)
		    (1 0.0 0.5)
		    (1 0.0 0.83)
		    (1 0.17 1.0)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("f" ((1 0.0 0.5)
		    (1 0.5 0.5)
		    (0 0 0)
		    (1 0.67 0.17)
		    (1 0.5 0.0)
		    (1 0.33 0.0)
		    (1 0.17 0.17)
		    (1 0.17 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("e" ((1 0.0 0.67)
		    (1 0.5 0.67)
		    (1 0.67 0.5)
		    (1 0.5 0.33)
		    (1 0.17 0.33)
		    (1 0.0 0.5)
		    (1 0.0 0.83)
		    (1 0.17 1.0)
		    (1 0.5 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("d" ((1 0.33 1.0)
		    (1 0.17 1.0)
		    (1 0.0 0.83)
		    (1 0.0 0.5)
		    (1 0.17 0.33)
		    (1 0.33 0.33)
		    (1 0.67 0.67)
		    (1 0.33 1.0)
		    (0 0 0)
		    (1 0.67 0.0)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("c" ((1 0.67 0.33)
		    (1 0.17 0.33)
		    (1 0.0 0.5)
		    (1 0.0 0.83)
		    (1 0.17 1.0)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("b" ((1 0.0 1.0)
		    (1 0.0 0.0)
		    (0 0 0)
		    (1 0.33 0.33)
		    (1 0.5 0.33)
		    (1 0.67 0.5)
		    (1 0.67 0.83)
		    (1 0.5 1.0)
		    (1 0.33 1.0)
		    (1 0.0 0.67)
		    (1 0.33 0.33)
		    (2 0.77 0.0)
		  )
	     )
	     ("a" ((1 0.5 0.83)
		    (1 0.5 0.5)
		    (1 0.33 0.33)
		    (1 0.17 0.33)
		    (1 0.0 0.5)
		    (1 0.0 0.83)
		    (1 0.17 1.0)
		    (1 0.33 1.0)
		    (1 0.5 0.83)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("9" ((1 0.17 1.0)
		    (1 0.33 1.0)
		    (1 0.67 0.67)
		    (1 0.67 0.17)
		    (1 0.5 0.0)
		    (1 0.17 0.0)
		    (1 0.0 0.17)
		    (1 0.0 0.33)
		    (1 0.17 0.5)
		    (1 0.67 0.5)
		    (2 0.77 0.0)
		  )
	     )
	     ("8" ((1 0.17 0.5)
		    (1 0.5 0.5)
		    (0 0 0)
		    (1 0.17 0.0)
		    (1 0.5 0.0)
		    (1 0.67 0.17)
		    (1 0.67 0.33)
		    (1 0.5 0.5)
		    (1 0.67 0.67)
		    (1 0.67 0.83)
		    (1 0.5 1.0)
		    (1 0.17 1.0)
		    (1 0.0 0.83)
		    (1 0.0 0.67)
		    (1 0.17 0.5)
		    (1 0.0 0.33)
		    (1 0.0 0.17)
		    (1 0.17 0.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("7"
	       ((1 0.0 0.0) (1 0.67 0.0) (1 0.17 1.0) (2 0.77 0.0))
	     )
	     ("6" ((1 0.0 0.5)
		    (1 0.5 0.5)
		    (1 0.67 0.67)
		    (1 0.67 0.83)
		    (1 0.5 1.0)
		    (1 0.17 1.0)
		    (1 0.0 0.83)
		    (1 0.0 0.33)
		    (1 0.33 0.0)
		    (1 0.5 0.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("5" ((1 0.0 0.83)
		    (1 0.17 1.0)
		    (1 0.5 1.0)
		    (1 0.67 0.83)
		    (1 0.67 0.5)
		    (1 0.5 0.33)
		    (1 0.0 0.33)
		    (1 0.0 0.0)
		    (1 0.67 0.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("4" ((1 0.67 0.67)
		    (1 0.0 0.67)
		    (1 0.5 0.0)
		    (1 0.5 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("3" ((1 0.0 0.17)
		    (1 0.17 0.0)
		    (1 0.5 0.0)
		    (1 0.67 0.17)
		    (1 0.67 0.33)
		    (1 0.5 0.5)
		    (0 0 0)
		    (1 0.33 0.5)
		    (1 0.5 0.5)
		    (1 0.67 0.67)
		    (1 0.67 0.83)
		    (1 0.5 1.0)
		    (1 0.17 1.0)
		    (1 0.0 0.83)
		    (2 0.77 0.0)
		  )
	     )
	     ("2" ((1 0.0 0.17)
		    (1 0.17 0.0)
		    (1 0.5 0.0)
		    (1 0.67 0.17)
		    (1 0.67 0.33)
		    (1 0.5 0.5)
		    (1 0.17 0.5)
		    (1 0.0 0.67)
		    (1 0.0 1.0)
		    (1 0.67 1.0)
		    (2 0.77 0.0)
		  )
	     )
	     ("1" ((1 0.0 0.17)
		    (1 0.17 0.0)
		    (1 0.17 1.0)
		    (0 0 0)
		    (1 0.0 1.0)
		    (1 0.33 1.0)
		    (2 0.43 0.0)
		  )
	     )
	     ("0" ((1 0.0 0.83)
		    (1 0.0 0.17)
		    (1 0.17 0.0)
		    (1 0.33 0.0)
		    (1 0.5 0.17)
		    (1 0.5 0.83)
		    (1 0.33 1.0)
		    (1 0.17 1.0)
		    (1 0.0 0.83)
		    (2 0.6 0.0)
		  )
	     )
	   )
	 )
  )
  (SETQ ZEICHEN (NTH 0 FONT_LIST))
  (SETQ DATA (CADR ZEICHEN))
  (SETQ PUNKT (NTH 0 DATA))
  (SETQ	FONT_LIST
	 (MAPCAR
	   (QUOTE
	     (LAMBDA (ZEICHEN)
	       (SETQ DATA (CADR ZEICHEN))
	       (LIST (CAR ZEICHEN)
		     (APPLY
		       (QUOTE APPEND)
		       (MAPCAR
			 (QUOTE
			   (LAMBDA (PUNKT)
			     (IF (= (CAR PUNKT) 1)
			       (PROGN (SETQ DUMMY (LIST PUNKT))
				      (SETQ ALT_PUNKT PUNKT)
			       )
			       (PROGN
				 (SETQ DUMMY (LIST ALT_PUNKT PUNKT))
				 (SETQ ALT_PUNKT nil)
			       )
			     )
			     DUMMY
			   )
			 )
			 DATA
		       )
		     )
	       )
	     )
	   )
	   FONT_LIST
	 )
  )
  (SETQ B (DIMX_TILE IMAGE_NAME))
  (SETQ H (DIMY_TILE IMAGE_NAME))
  (SETQ W 15)
  (SETQ W_LIST nil)
  (REPEAT 16
    (SETQ W_LIST (CONS (* (/ (* 2.0 PI) 16.0) W) W_LIST))
    (SETQ W (1- W))
  )
  (SETQ	DATA_LIST
	 (MAPCAR
	   (QUOTE
	     (LAMBDA (DATA)
	       (CONS (STRCASE (CAR DATA))
		     (MAPCAR
		       (QUOTE (LAMBDA (DAT)
				(CONS (STRCASE (CAR DAT)) (CDR DAT))
			      )
		       )
		       (CDR DATA)
		     )
	       )
	     )
	   )
	   DATA_LIST
	 )
  )
  (FOREACH DATA	DATA_LIST
    (SETQ ART (CAR DATA))
    (SETQ DATA (CDR DATA))
    (COND ((= ART "FILL")
	   (SETQ COLOR (CADR (ASSOC "COLOR" DATA)))
	   (IF (SETQ P1 (CADR (ASSOC "P1" DATA)))
	     (SETQ P1X (:M-ROUND (* (/ B 100.0) (CAR P1)))
		   P1Y (:M-ROUND (* (/ H 100.0) (CADR P1)))
	     )
	     (SETQ P1X 0
		   P1Y 0
	     )
	   )
	   (IF (SETQ P2 (CADR (ASSOC "P2" DATA)))
	     (SETQ P2X (:M-ROUND
			 (- (* (/ B 100.0) (CAR P2)) (* (/ B 100.0) (CAR P1)))
		       )
		   P2Y (:M-ROUND
			 (- (* (/ H 100.0) (CADR P2)) (* (/ H 100.0) (CADR P1)))
		       )
	     )
	     (SETQ P2X B
		   P2Y H
	     )
	   )
	   (START_IMAGE IMAGE_NAME)
	   (FILL_IMAGE P1X P1Y P2X P2Y COLOR)
	   (END_IMAGE)
	  )
	  ((= ART "CIRCLE")
	   (SETQ CENTER (CADR (ASSOC "CENTER" DATA)))
	   (SETQ COLOR (CADR (ASSOC "COLOR" DATA)))
	   (SETQ RADIUS (CADR (ASSOC "RADIUS" DATA)))
	   (SETQ CENTER
		  (MAPCAR (QUOTE *)
			  (MAPCAR (QUOTE /) (LIST B H) (LIST 100.0 100.0))
			  CENTER
		  )
	   )
	   (SETQ RADIUS (* (/ 100.0 (APPLY (QUOTE MIN) (LIST B H))) RADIUS))
	   (IF (NULL (SETQ RATIO (CADR (ASSOC "RATIO" DATA))))
	     (SETQ RATIO 1.0)
	   )
	   (IF (NULL (SETQ WINKEL (CADR (ASSOC "ANGLE" DATA))))
	     (SETQ WINKEL 0)
	   )
	   (SETQ DUMMY_LIST
		  (MAPCAR
		    (QUOTE
		      (LAMBDA (W)
			(MAPCAR
			  (QUOTE FIX)
			  (MAPCAR
			    (QUOTE +)
			    (K_P_TWIST
			      (MAPCAR (QUOTE *)
				      (POLAR (QUOTE (0 0)) W RADIUS)
				      (LIST 1.0 RATIO)
			      )
			      (QUOTE (0 0))
			      (- 0 WINKEL)
			    )
			    CENTER
			  )
			)
		      )
		    )
		    W_LIST
		  )
	   )
	   (SETQ
	     P_LIST (APPEND
		      P_LIST
		      (MAPCAR
			(QUOTE (LAMBDA (P1 P2) (LIST P1 P2 COLOR)))
			DUMMY_LIST
			(APPEND (CDR DUMMY_LIST) (LIST (CAR DUMMY_LIST)))
		      )
		    )
	   )
	  )
	  ((= ART "RECTANG")
	   (SETQ POSITION (CADR (ASSOC "POSITION" DATA)))
	   (SETQ COLOR (CADR (ASSOC "COLOR" DATA)))
	   (SETQ WIDTH (CADR (ASSOC "WIDTH" DATA)))
	   (SETQ HEIGHT (CADR (ASSOC "HEIGHT" DATA)))
	   (SETQ
	     POSITION (MAPCAR
			(QUOTE *)
			(MAPCAR (QUOTE /) (LIST B H) (LIST 100.0 100.0))
			POSITION
		      )
	   )
	   (SETQ HEIGHT (* (/ H 100.0) HEIGHT))
	   (SETQ WIDTH (* (/ B 100.0) WIDTH))
	   (IF (NULL (SETQ WINKEL (CADR (ASSOC "ANGLE" DATA))))
	     (SETQ WINKEL 0)
	   )
	   (SETQ P1 (POLAR (POLAR (QUOTE (0 0)) 0 (/ WIDTH 2.0))
			   (* PI 1.5)
			   (/ HEIGHT 2.0)
		    )
	   )
	   (SETQ P2 (POLAR P1 (* PI 0.5) HEIGHT))
	   (SETQ P3 (POLAR P2 PI WIDTH))
	   (SETQ P4 (POLAR P3 (* PI 1.5) HEIGHT))
	   (SETQ DUMMY_LIST
		  (MAPCAR
		    (QUOTE
		      (LAMBDA (P)
			(MAPCAR
			  (QUOTE :M-ROUND)
			  (MAPCAR
			    (QUOTE +)
			    (K_P_TWIST P (QUOTE (0 0)) (- 0 WINKEL))
			    POSITION
			  )
			)
		      )
		    )
		    (LIST P1 P2 P3 P4)
		  )
	   )
	   (SETQ
	     P_LIST (APPEND
		      P_LIST
		      (MAPCAR
			(QUOTE (LAMBDA (P1 P2) (LIST P1 P2 COLOR)))
			DUMMY_LIST
			(APPEND (CDR DUMMY_LIST) (LIST (CAR DUMMY_LIST)))
		      )
		    )
	   )
	  )
	  ((= ART "ARROW")
	   (SETQ START (CADR (ASSOC "START" DATA)))
	   (SETQ END (CADR (ASSOC "END" DATA)))
	   (SETQ SIZE (CADR (ASSOC "SIZE" DATA)))
	   (SETQ COLOR (CADR (ASSOC "COLOR" DATA)))
	   (IF (NOT (SETQ RATIO (CADR (ASSOC "RATIO" DATA))))
	     (SETQ RATIO 1.0)
	   )
	   (SETQ START
		  (MAPCAR (QUOTE *)
			  (MAPCAR (QUOTE /) (LIST B H) (LIST 100.0 100.0))
			  START
		  )
	   )
	   (SETQ
	     END (MAPCAR (QUOTE *)
			 (MAPCAR (QUOTE /) (LIST B H) (LIST 100.0 100.0))
			 END
		 )
	   )
	   (SETQ SIZE (* (/ 100.0 (APPLY (QUOTE MIN) (LIST B H))) SIZE))
	   (SETQ P1 (MAPCAR (QUOTE FIX)
			    (POLAR (POLAR END (ANGLE END START) SIZE)
				   (- (ANGLE END START) (/ PI 2.0))
				   (* SIZE RATIO 0.5)
			    )
		    )
	   )
	   (SETQ P2 (MAPCAR (QUOTE FIX)
			    (POLAR (POLAR END (ANGLE END START) SIZE)
				   (+ (ANGLE END START) (/ PI 2.0))
				   (* SIZE RATIO 0.5)
			    )
		    )
	   )
	   (SETQ START (MAPCAR (QUOTE FIX) START))
	   (SETQ END (MAPCAR (QUOTE FIX) END))
	   (SETQ P_LIST	(APPEND	P_LIST
				(LIST (LIST START END COLOR)
				      (LIST END P1 COLOR)
				      (LIST P1 P2 COLOR)
				      (LIST P2 END COLOR)
				)
			)
	   )
	  )
	  ((= ART "LINE")
	   (SETQ START (CADR (ASSOC "START" DATA)))
	   (SETQ END (CADR (ASSOC "END" DATA)))
	   (SETQ COLOR (CADR (ASSOC "COLOR" DATA)))
	   (SETQ START
		  (MAPCAR (QUOTE *)
			  (MAPCAR (QUOTE /) (LIST B H) (LIST 100.0 100.0))
			  START
		  )
	   )
	   (SETQ
	     END (MAPCAR (QUOTE *)
			 (MAPCAR (QUOTE /) (LIST B H) (LIST 100.0 100.0))
			 END
		 )
	   )
	   (SETQ START (MAPCAR (QUOTE FIX) START))
	   (SETQ END (MAPCAR (QUOTE FIX) END))
	   (SETQ P_LIST (APPEND P_LIST (LIST (LIST START END COLOR))))
	  )
	  ((= ART "PLINE")
	   (SETQ PLIST (CDR (ASSOC "PLIST" DATA)))
	   (SETQ COLOR (CADR (ASSOC "COLOR" DATA)))
	   (SETQ
	     PLIST (MAPCAR
		     (QUOTE (LAMBDA (P)
			      (SETQ
				P (MAPCAR (QUOTE FIX)
					  (MAPCAR (QUOTE *)
						  (MAPCAR (QUOTE /)
							  (LIST B H)
							  (LIST 100.0 100.0)
						  )
						  P
					  )
				  )
			      )
			    )
		     )
		     PLIST
		   )
	   )
	   (SETQ
	     P_LIST (APPEND
		      P_LIST
		      (MAPCAR (QUOTE (LAMBDA (P1 P2) (LIST P1 P2 COLOR)))
			      PLIST
			      (APPEND (CDR PLIST) (LIST (CAR PLIST)))
		      )
		    )
	   )
	  )
	  ((= ART "TEXT")
	   (SETQ TEXT (CADR (ASSOC "TEXT" DATA)))
	   (SETQ COLOR (CADR (ASSOC "COLOR" DATA)))
	   (SETQ HOEHE (CADR (ASSOC "HEIGHT" DATA)))
	   (SETQ BREITE (CADR (ASSOC "WIDTH" DATA)))
	   (IF (NULL BREITE)
	     (SETQ BREITE 1.0)
	   )
	   (SETQ CHR_LIST (MAPCAR (QUOTE CHR) (VL-STRING->LIST TEXT)))
	   (SETQ POS (CADR (ASSOC "POSITION" DATA)))
	   (SETQ RICHTUNG (CADR (ASSOC "ALIGNMENT" DATA)))
	   (IF (NULL RICHTUNG)
	     (SETQ RICHTUNG "lo")
	   )
	   (SETQ WINKEL (CADR (ASSOC "ANGLE" DATA)))
	   (IF (NULL WINKEL)
	     (SETQ WINKEL 0)
	   )
	   (SETQ
	     POS (MAPCAR (QUOTE *)
			 (MAPCAR (QUOTE /) (LIST B H) (LIST 100.0 100.0))
			 POS
		 )
	   )
	   (SETQ HOEHE (* (/ H 100.0) HOEHE))
	   (SETQ DUMMY_LIST
		  (MAPCAR (QUOTE (LAMBDA (C)
				   (SETQ TEMP_LIST
					  (MAPCAR
					    (QUOTE
					      (LAMBDA (PL)
						(MAPCAR	(QUOTE *)
							PL
							(LIST 1 HOEHE HOEHE)
						)
					      )
					    )
					    (CADR (ASSOC C FONT_LIST))
					  )
				   )
				   (SETQ C_LIST
					  (VL-REMOVE
					    (QUOTE nil)
					    (MAPCAR
					      (QUOTE
						(LAMBDA	(P1 P2)
						  (COND
						    ((AND (= (CAR P1) 1)
							  (= (CAR P2) 1)
						     )
						     (LIST
						       (MAPCAR
							 (QUOTE (LAMBDA (Z) Z))
							 (MAPCAR
							   (QUOTE +)
							   POS
							   (MAPCAR
							     (QUOTE *)
							     (CDR P1)
							     (LIST BREITE 1)
							   )
							 )
						       )
						       (MAPCAR
							 (QUOTE (LAMBDA (Z) Z))
							 (MAPCAR
							   (QUOTE +)
							   POS
							   (MAPCAR
							     (QUOTE *)
							     (CDR P2)
							     (LIST BREITE 1)
							   )
							 )
						       )
						       COLOR
						     )
						    )
						    ((= (CAR P2) 2)
						     (SETQ POS
							    (MAPCAR
							      (QUOTE +)
							      POS
							      (MAPCAR
								(QUOTE *)
								(CDR P2)
								(LIST BREITE 1)
							      )
							    )
						     )
						     nil
						    )
						  )
						)
					      )
					      (I-CDR TEMP_LIST)
					      (CDR TEMP_LIST)
					    )
					  )
				   )
				   (SETQ POS
					  (LIST
					    (MAX
					      (CAR POS)
					      (+ 2
						 (APPLY
						   (QUOTE MAX)
						   (MAPCAR (QUOTE CAR)
							   (VL-REMOVE-IF-NOT
							     (QUOTE LISTP)
							     (APPLY (QUOTE APPEND)
								    C_LIST
							     )
							   )
						   )
						 )
					      )
					    )
					    (CADR POS)
					  )
				   )
				   C_LIST
				 )
			  )
			  CHR_LIST
		  )
	   )
	   (SETQ DUMMY_LIST (APPLY (QUOTE APPEND) DUMMY_LIST))
	   (SETQ Y-LIST	(APPEND	(MAPCAR (QUOTE CAAR) DUMMY_LIST)
				(MAPCAR (QUOTE CAADR) DUMMY_LIST)
			)
	   )
	   (SETQ X-LIST	(APPEND	(MAPCAR (QUOTE CADAR) DUMMY_LIST)
				(MAPCAR (QUOTE CADADR) DUMMY_LIST)
			)
	   )
	   (SETQ MIN-Y (APPLY (QUOTE MIN) Y-LIST))
	   (SETQ MAX-Y (APPLY (QUOTE MAX) Y-LIST))
	   (SETQ MIN-X (APPLY (QUOTE MIN) X-LIST))
	   (SETQ MAX-X (APPLY (QUOTE MAX) X-LIST))
	   (SETQ DX (- MAX-X MIN-X))
	   (SETQ DY (- MAX-Y MIN-Y))
	   (COND ((= RICHTUNG "ol") nil)
		 ((= RICHTUNG "ml")
		  (SETQ	DUMMY_LIST
			 (MAPCAR (QUOTE	(LAMBDA	(DUMMY)
					  (LIST	(MAPCAR	(QUOTE -)
							(CAR DUMMY)
							(LIST 0 (/ DX 2))
						)
						(MAPCAR	(QUOTE -)
							(CADR DUMMY)
							(LIST 0 (/ DX 2))
						)
						(CADDR DUMMY)
					  )
					)
				 )
				 DUMMY_LIST
			 )
		  )
		 )
		 ((= RICHTUNG "ul")
		  (SETQ	DUMMY_LIST
			 (MAPCAR (QUOTE	(LAMBDA	(DUMMY)
					  (LIST	(MAPCAR	(QUOTE -)
							(CAR DUMMY)
							(LIST 0 DX)
						)
						(MAPCAR	(QUOTE -)
							(CADR DUMMY)
							(LIST 0 DX)
						)
						(CADDR DUMMY)
					  )
					)
				 )
				 DUMMY_LIST
			 )
		  )
		 )
		 ((= RICHTUNG "oz")
		  (SETQ	DUMMY_LIST
			 (MAPCAR (QUOTE	(LAMBDA	(DUMMY)
					  (LIST	(MAPCAR	(QUOTE -)
							(CAR DUMMY)
							(LIST (/ DY 2) 0)
						)
						(MAPCAR	(QUOTE -)
							(CADR DUMMY)
							(LIST (/ DY 2) 0)
						)
						(CADDR DUMMY)
					  )
					)
				 )
				 DUMMY_LIST
			 )
		  )
		 )
		 ((= RICHTUNG "mz")
		  (SETQ	DUMMY_LIST
			 (MAPCAR
			   (QUOTE (LAMBDA (DUMMY)
				    (LIST (MAPCAR (QUOTE -)
						  (CAR DUMMY)
						  (LIST (/ DY 2) (/ DX 2))
					  )
					  (MAPCAR (QUOTE -)
						  (CADR DUMMY)
						  (LIST (/ DY 2) (/ DX 2))
					  )
					  (CADDR DUMMY)
				    )
				  )
			   )
			   DUMMY_LIST
			 )
		  )
		 )
		 ((= RICHTUNG "uz")
		  (SETQ	DUMMY_LIST
			 (MAPCAR (QUOTE	(LAMBDA	(DUMMY)
					  (LIST	(MAPCAR	(QUOTE -)
							(CAR DUMMY)
							(LIST (/ DY 2) DX)
						)
						(MAPCAR	(QUOTE -)
							(CADR DUMMY)
							(LIST (/ DY 2) DX)
						)
						(CADDR DUMMY)
					  )
					)
				 )
				 DUMMY_LIST
			 )
		  )
		 )
		 ((= RICHTUNG "or")
		  (SETQ	DUMMY_LIST
			 (MAPCAR (QUOTE	(LAMBDA	(DUMMY)
					  (LIST	(MAPCAR	(QUOTE -)
							(CAR DUMMY)
							(LIST DY 0)
						)
						(MAPCAR	(QUOTE -)
							(CADR DUMMY)
							(LIST DY 0)
						)
						(CADDR DUMMY)
					  )
					)
				 )
				 DUMMY_LIST
			 )
		  )
		 )
		 ((= RICHTUNG "mr")
		  (SETQ	DUMMY_LIST
			 (MAPCAR (QUOTE	(LAMBDA	(DUMMY)
					  (LIST	(MAPCAR	(QUOTE -)
							(CAR DUMMY)
							(LIST DY (/ DX 2))
						)
						(MAPCAR	(QUOTE -)
							(CADR DUMMY)
							(LIST DY (/ DX 2))
						)
						(CADDR DUMMY)
					  )
					)
				 )
				 DUMMY_LIST
			 )
		  )
		 )
		 ((= RICHTUNG "ur")
		  (SETQ	DUMMY_LIST
			 (MAPCAR (QUOTE	(LAMBDA	(DUMMY)
					  (LIST	(MAPCAR	(QUOTE -)
							(CAR DUMMY)
							(LIST DY DX)
						)
						(MAPCAR	(QUOTE -)
							(CADR DUMMY)
							(LIST DY DX)
						)
						(CADDR DUMMY)
					  )
					)
				 )
				 DUMMY_LIST
			 )
		  )
		 )
	   )
	   (SETQ
	     POS (MAPCAR (QUOTE *)
			 (MAPCAR (QUOTE /) (LIST B H) (LIST 100.0 100.0))
			 (CADR (ASSOC "POSITION" DATA))
		 )
	   )
	   (SETQ DUMMY_LIST
		  (MAPCAR
		    (QUOTE
		      (LAMBDA (DUMMY)
			(LIST
			  (:M-ROUNDTOEVEN
			    (K_P_TWIST (CAR DUMMY) POS (- 0 WINKEL))
			  )
			  (:M-ROUNDTOEVEN
			    (K_P_TWIST (CADR DUMMY) POS (- 0 WINKEL))
			  )
			  (LAST DUMMY)
			)
		      )
		    )
		    DUMMY_LIST
		  )
	   )
	   (SETQ P_LIST (APPEND P_LIST DUMMY_LIST))
	  )
    )
  )
  (START_IMAGE IMAGE_NAME)
  (MAPCAR (QUOTE (LAMBDA (DATA)
		   (VECTOR_IMAGE
		     (NTH 0 (NTH 0 DATA))
		     (NTH 1 (NTH 0 DATA))
		     (NTH 0 (NTH 1 DATA))
		     (NTH 1 (NTH 1 DATA))
		     (NTH 2 DATA)
		   )
		 )
	  )
	  P_LIST
  )
  (END_IMAGE)
)
(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-DEF (OBJ_NAME FILE)
  (IF (NULL FILE)
    (SETQ FILE (K_AC-DOC))
  )
  (SETQ OBJ_NAME (K_->OBJ_NAME OBJ_NAME))
  (COND
    ((= (vla-get-ObjectName OBJ_NAME) "AcDbBlockReference")
     (vla-Item (vla-get-Blocks FILE) (vla-get-Name OBJ_NAME))
    )
    ((= (vla-get-ObjectName OBJ_NAME) "AcDbAttribute")
     (CAR
       (K_FILTER
	 (K_COLLECTION->LIST
	   (vla-Item
	     (vla-get-Blocks FILE)
	     (CDR (ASSOC
		    2
		    (ENTGET
		      (CDR (ASSOC 330 (ENTGET (K_->ENT_NAME OBJ_NAME))))
		    )
		  )
	     )
	   )
	 )
	 (LIST "tagstring" (vla-get-TagString OBJ_NAME))
       )
     )
    )
    ((= (vla-get-ObjectName OBJ_NAME) "AcDbMline")
     (vla-Item (vla-Item (vla-get-Dictionaries FILE) "acad_mlinestyle")
	       (vla-get-StyleName OBJ_NAME)
     )
    )
    ((= (vla-get-ObjectName OBJ_NAME) "AcDbMLeader")
     (vla-Item (vla-Item (vla-get-Dictionaries FILE) "acad_mleaderstyle")
	       (vla-get-StyleName OBJ_NAME)
     )
    )
    ((MEMBER (vla-get-ObjectName OBJ_NAME)
	     (QUOTE ("AcDbAlignedDimension" "AcDbRotatedDimension"))
     )
     (vla-Item (vla-get-Blocks FILE)
	       (CDR (ASSOC 2 (ENTGET (K_->ENT_NAME OBJ_NAME))))
     )
    )
    (T nil)
  )
)
(DEFUN K_GET-INI-DIR (SUCHPFAD / INI_DIR ORDNER SUCHPFAD SUCHPFAD_ALT)
  (IF (VL-FILE-DIRECTORY-P (GETVAR "dwgprefix"))
    (PROGN (IF (NOT SUCHPFAD)
	     (SETQ SUCHPFAD "")
	   )
	   (IF (NOT (VL-FILE-DIRECTORY-P SUCHPFAD))
	     (SETQ SUCHPFAD (GETVAR "dwgprefix"))
	   )
	   (SETQ ORDNER (K_GET_GLOBAL_INI "Ordner"))
	   (WHILE (AND (NOT INI_DIR)
		       SUCHPFAD
		       (NOT (EQUAL SUCHPFAD_ALT SUCHPFAD))
		  )
	     (SETQ SUCHPFAD_ALT SUCHPFAD)
	     (FOREACH DIR ORDNER
	       (IF (VL-FILE-DIRECTORY-P (STRCAT SUCHPFAD "\\" DIR))
		 (SETQ INI_DIR (STRCAT SUCHPFAD "\\" DIR "\\"))
	       )
	     )
	     (SETQ SUCHPFAD (K_PATHBACKSLASH
			      (VL-FILENAME-DIRECTORY
				(K_PATHBACKSLASH SUCHPFAD T)
			      )
			      T
			    )
	     )
	   )
	   (IF INI_DIR
	     INI_DIR
	     (GETVAR "dwgprefix")
	   )
    )
    (ALERT
      "Pfad und/oder Dateiname enthält nicht lesbare Sonderzeichen"
    )
  )
)
(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_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_DATA (OBJ_NAMEN BEZ APP_LIST ART /)
  (DEFUN K_GET_DATA_WORK (OBJ_NAME  /	      ATT_LIST	DAT
			  DATA	    DATA_LIST DYN_LIST	ML_LIST
			  OBJ	    PROP      XDATA	XTYPE
			 )
    (IF	(AND OBJ_NAME (ENTGET (K_->ENT_NAME OBJ_NAME)))
      (PROGN
	(IF (= (TYPE APP_LIST) (QUOTE STR))
	  (SETQ APP_LIST (LIST APP_LIST))
	)
	(IF (= (TYPE ART) (QUOTE STR))
	  (SETQ ART (LIST ART))
	)
	(IF (= (TYPE OBJ_NAME) (QUOTE ENAME))
	  (SETQ OBJ_NAME (vlax-ename->vla-object OBJ_NAME))
	)
	(IF
	  (AND (OR (NULL ART) (MEMBER "*" ART) (MEMBER "ATT" ART))
	       (L-CONJUNCTION
		 (IF (LISTP BEZ)
		   BEZ
		   (LIST BEZ)
		 )
		 (LIST "*" (K_GET_INI "Attribut für Bezeichnung" nil))
	       )
	       (= (vla-get-ObjectName OBJ_NAME) "AcDbMline")
	  )
	   (SETQ ML_LIST
		  (LIST
		    (LIST (K_GET_INI "Attribut für Bezeichnung" nil)
			  (CDR (ASSOC 3
				      (DICTSEARCH
					(CDR (ASSOC -1
						    (DICTSEARCH
						      (NAMEDOBJDICT)
						      "ACAD_MLINESTYLE"
						    )
					     )
					)
					(vla-get-StyleName OBJ_NAME)
				      )
			       )
			  )
		    )
		  )
	   )
	)
	(IF
	  (AND
	    (OR (NULL ART) (MEMBER "ATT" (MAPCAR (QUOTE STRCASE) ART)))
	    (SETQ ATT_OBJ_LIST
		   (MAPCAR (QUOTE K_->OBJ_NAME)
			   (K_GET_SUBOBJ OBJ_NAME)
		   )
	    )
	  )
	   (SETQ ATT_LIST
		  (MAPCAR
		    (QUOTE
		      (LAMBDA (OBJ)
			(LIST
			  (CDR (ASSOC 2 (ENTGET (K_->ENT_NAME OBJ))))
			  (CDR (ASSOC 1 (ENTGET (K_->ENT_NAME OBJ))))
			)
		      )
		    )
		    ATT_OBJ_LIST
		  )
	   )
	   (SETQ
	     ATT_LIST (MAPCAR (QUOTE (LAMBDA (OBJ)
				       (LIST (vla-get-TagString OBJ)
					     (K_GET-TEXTSTRING OBJ)
				       )
				     )
			      )
			      ATT_OBJ_LIST
		      )
	   )
	)
	(IF
	  (AND
	    (OR (NULL ART) (MEMBER "DYN" (MAPCAR (QUOTE STRCASE) ART)))
	    (vlax-property-available-p OBJ_NAME "isdynamicblock")
	    (= (vla-get-IsDynamicBlock OBJ_NAME) :vlax-true)
	    (vlax-method-applicable-p
	      OBJ_NAME
	      (QUOTE GETDYNAMICBLOCKPROPERTIES)
	    )
	  )
	   (SETQ DYN_LIST
		  (VL-REMOVE
		    (QUOTE nil)
		    (MAPCAR
		      (QUOTE (LAMBDA (PROP)
			       (IF (= (vla-get-Show PROP) :vlax-true)
				 (LIST (vla-get-PropertyName PROP)
				       (vlax-variant-value
					 (vla-get-Value PROP)
				       )
				 )
			       )
			     )
		      )
		      (vlax-invoke
			OBJ_NAME
			(QUOTE GETDYNAMICBLOCKPROPERTIES)
		      )
		    )
		  )
	   )
	)
	(IF
	  (AND
	    (OR (NULL ART) (MEMBER "EED" (MAPCAR (QUOTE STRCASE) ART)))
	    (MEMBER "*" APP_LIST)
	  )
	   (VLAX-FOR APP (vla-get-RegisteredApplications
			   (vla-get-Document OBJ_NAME)
			 )
	     (IF (AND (NOT (VL-CATCH-ALL-ERROR-P
			     (VL-CATCH-ALL-APPLY
			       (QUOTE vla-GetXData)
			       (LIST OBJ_NAME
				     (vla-get-Name APP)
				     (QUOTE XTYPE)
				     (QUOTE XDATA)
			       )
			     )
			   )
		      )
		      XTYPE
		      XDATA
		 )
	       (PROGN (vlax-safearray->list XTYPE)
		      (SETQ DATA_LIST
			     (APPEND
			       DATA_LIST
			       (VL-REMOVE-IF-NOT
				 (QUOTE
				   (LAMBDA (DATA)
				     (= (TYPE (CAR DATA)) (QUOTE STR))
				   )
				 )
				 (GATHER
				   (CDR
				     (MAPCAR (QUOTE vlax-variant-value)
					     (vlax-safearray->list XDATA)
				     )
				   )
				   2
				 )
			       )
			     )
		      )
	       )
	     )
	   )
	   (FOREACH APP	APP_LIST
	     (IF
	       (AND
		 (NOT (VL-CATCH-ALL-ERROR-P
			(VL-CATCH-ALL-APPLY
			  (QUOTE vla-GetXData)
			  (LIST OBJ_NAME APP (QUOTE XTYPE) (QUOTE XDATA))
			)
		      )
		 )
		 XTYPE
		 XDATA
	       )
		(PROGN (vlax-safearray->list XTYPE)
		       (SETQ DATA_LIST
			      (APPEND
				DATA_LIST
				(VL-REMOVE-IF-NOT
				  (QUOTE
				    (LAMBDA (DATA)
				      (= (TYPE (CAR DATA)) (QUOTE STR))
				    )
				  )
				  (GATHER
				    (CDR
				      (MAPCAR (QUOTE vlax-variant-value)
					      (vlax-safearray->list XDATA)
				      )
				    )
				    2
				  )
				)
			      )
		       )
		)
	     )
	   )
	)
	(COND
	  ((= (TYPE BEZ) (QUOTE STR))
	   (IF (= BEZ "*")
	     (PROGN
	       (SETQ DATA (APPEND ML_LIST ATT_LIST DATA_LIST DYN_LIST))
	     )
	     (PROGN (SETQ
		      DATA (COND
			     ((vlax-property-available-p OBJ_NAME BEZ)
			      (IF (VL-CATCH-ALL-ERROR-P
				    (SETQ DATA
					   (VL-CATCH-ALL-APPLY
					     (QUOTE getpropertyvalue)
					     (LIST (K_->ENT_NAME OBJ_NAME) BEZ)
					   )
				    )
				  )
				(SETQ DATA
				       (EVAL
					 (LIST (READ (STRCAT "vla-get-" BEZ))
					       OBJ_NAME
					 )
				       )
				)
				DATA
			      )
			     )
			     ((ASSOC BEZ ML_LIST)
			      (SETQ DATA (NTH 1 (ASSOC BEZ ML_LIST)))
			     )
			     ((ASSOC
				(STRCASE BEZ)
				(MAPCAR
				  (QUOTE
				    (LAMBDA (DAT)
				      (LIST (STRCASE (CAR DAT)) (CADR DAT))
				    )
				  )
				  ML_LIST
				)
			      )
			      (SETQ DATA
				     (NTH
				       1
				       (ASSOC
					 (STRCASE BEZ)
					 (MAPCAR
					   (QUOTE (LAMBDA (DAT)
						    (LIST (STRCASE (CAR DAT))
							  (CADR DAT)
						    )
						  )
					   )
					   ML_LIST
					 )
				       )
				     )
			      )
			     )
			     ((ASSOC BEZ DYN_LIST)
			      (SETQ DATA (NTH 1 (ASSOC BEZ DYN_LIST)))
			     )
			     ((ASSOC
				(STRCASE BEZ)
				(MAPCAR
				  (QUOTE
				    (LAMBDA (DAT)
				      (LIST (STRCASE (CAR DAT)) (CADR DAT))
				    )
				  )
				  DYN_LIST
				)
			      )
			      (SETQ DATA
				     (NTH
				       1
				       (ASSOC
					 (STRCASE BEZ)
					 (MAPCAR
					   (QUOTE (LAMBDA (DAT)
						    (LIST (STRCASE (CAR DAT))
							  (CADR DAT)
						    )
						  )
					   )
					   DYN_LIST
					 )
				       )
				     )
			      )
			     )
			     ((ASSOC BEZ ATT_LIST)
			      (SETQ DATA (NTH 1 (ASSOC BEZ ATT_LIST)))
			     )
			     ((ASSOC
				(STRCASE BEZ)
				(MAPCAR
				  (QUOTE
				    (LAMBDA (DAT)
				      (LIST (STRCASE (CAR DAT)) (CADR DAT))
				    )
				  )
				  ATT_LIST
				)
			      )
			      (SETQ DATA
				     (NTH
				       1
				       (ASSOC
					 (STRCASE BEZ)
					 (MAPCAR
					   (QUOTE (LAMBDA (DAT)
						    (LIST (STRCASE (CAR DAT))
							  (CADR DAT)
						    )
						  )
					   )
					   ATT_LIST
					 )
				       )
				     )
			      )
			     )
			     ((ASSOC BEZ DATA_LIST)
			      (SETQ DATA (NTH 1 (ASSOC BEZ DATA_LIST)))
			     )
			     ((ASSOC
				(STRCASE BEZ)
				(MAPCAR
				  (QUOTE
				    (LAMBDA (DAT)
				      (LIST (STRCASE (CAR DAT)) (CADR DAT))
				    )
				  )
				  DATA_LIST
				)
			      )
			      (SETQ DATA
				     (NTH
				       1
				       (ASSOC
					 (STRCASE BEZ)
					 (MAPCAR
					   (QUOTE (LAMBDA (DAT)
						    (LIST (STRCASE (CAR DAT))
							  (CADR DAT)
						    )
						  )
					   )
					   DATA_LIST
					 )
				       )
				     )
			      )
			     )
			   )
		    )
	     )
	   )
	  )
	  ((= (TYPE BEZ) (QUOTE LIST))
	   (SETQ DATA
		  (MAPCAR
		    (QUOTE
		      (LAMBDA (BEZ / DATA)
			(COND
			  ((vlax-property-available-p OBJ_NAME BEZ)
			   (IF (VL-CATCH-ALL-ERROR-P
				 (SETQ
				   DATA	(VL-CATCH-ALL-APPLY
					  (QUOTE getpropertyvalue)
					  (LIST	(K_->ENT_NAME OBJ_NAME)
						BEZ
					  )
					)
				 )
			       )
			     (SETQ
			       DATA (EVAL
				      (LIST
					(READ (STRCAT "vla-get-" BEZ))
					OBJ_NAME
				      )
				    )
			     )
			   )
			  )
			  ((ASSOC BEZ DYN_LIST)
			   (SETQ DATA (NTH 1 (ASSOC BEZ DYN_LIST)))
			  )
			  ((ASSOC
			     (STRCASE BEZ)
			     (MAPCAR
			       (QUOTE
				 (LAMBDA (DAT)
				   (LIST (STRCASE (CAR DAT)) (CADR DAT))
				 )
			       )
			       DYN_LIST
			     )
			   )
			   (SETQ DATA
				  (NTH 1
				       (ASSOC
					 (STRCASE BEZ)
					 (MAPCAR
					   (QUOTE
					     (LAMBDA (DAT)
					       (LIST (STRCASE (CAR DAT))
						     (CADR DAT)
					       )
					     )
					   )
					   DYN_LIST
					 )
				       )
				  )
			   )
			  )
			  ((ASSOC BEZ ATT_LIST)
			   (SETQ DATA (NTH 1 (ASSOC BEZ ATT_LIST)))
			  )
			  ((ASSOC
			     (STRCASE BEZ)
			     (MAPCAR
			       (QUOTE
				 (LAMBDA (DAT)
				   (LIST (STRCASE (CAR DAT)) (CADR DAT))
				 )
			       )
			       ATT_LIST
			     )
			   )
			   (SETQ DATA
				  (NTH 1
				       (ASSOC
					 (STRCASE BEZ)
					 (MAPCAR
					   (QUOTE
					     (LAMBDA (DAT)
					       (LIST (STRCASE (CAR DAT))
						     (CADR DAT)
					       )
					     )
					   )
					   ATT_LIST
					 )
				       )
				  )
			   )
			  )
			  ((ASSOC BEZ DATA_LIST)
			   (SETQ DATA (NTH 1 (ASSOC BEZ DATA_LIST)))
			  )
			  ((ASSOC
			     (STRCASE BEZ)
			     (MAPCAR
			       (QUOTE
				 (LAMBDA (DAT)
				   (LIST (STRCASE (CAR DAT)) (CADR DAT))
				 )
			       )
			       DATA_LIST
			     )
			   )
			   (SETQ DATA
				  (NTH 1
				       (ASSOC
					 (STRCASE BEZ)
					 (MAPCAR
					   (QUOTE
					     (LAMBDA (DAT)
					       (LIST (STRCASE (CAR DAT))
						     (CADR DAT)
					       )
					     )
					   )
					   DATA_LIST
					 )
				       )
				  )
			   )
			  )
			)
			(LIST BEZ DATA)
		      )
		    )
		    BEZ
		  )
	   )
	  )
	)
      )
    )
    DATA
  )
  (COND	((LISTP OBJ_NAMEN)
	 (MAPCAR (QUOTE K_GET_DATA_WORK) OBJ_NAMEN)
	)
	((= (TYPE OBJ_NAMEN) (QUOTE PICKSET))
	 (MAPCAR (QUOTE K_GET_DATA_WORK) (K_SATZ->ENTLIST OBJ_NAMEN))
	)
	(T (K_GET_DATA_WORK OBJ_NAMEN))
  )
)
(DEFUN K_GET_GLOBAL_INI
       (EINTRAG / PFAD DATA INI_LIST INI_LIST_MAIN PFAD_MAIN)
  (IF (GETVAR "SECURELOAD")
    (PROGN (K_SAVE_VAR "SECURELOAD") (SETVAR "SECURELOAD" 0))
  )
  (IF
    (IF	(SETQ PFAD (FINDFILE "k_global.ini"))
      (PROGN (SETQ INI_LIST (K_LOAD PFAD)))
      (PROGN
	(IF (SETQ PFAD_MAIN (FINDFILE "k_main.ini"))
	  (PROGN
	    (SETQ INI_LIST (K_LOAD PFAD_MAIN))
	    (K_PRINT_DATEI
	      (SETQ PFAD (STRCAT (K_PROGRAMMPOSITION) "k_global.ini"))
	      INI_LIST
	    )
	    (SETQ INI_LIST (K_LOAD PFAD))
	  )
	)
      )
    )
     (IF (NULL (SETQ DATA (K_CHECK_ASSOC EINTRAG INI_LIST nil)))
       (PROGN (SETQ PFAD_MAIN (FINDFILE "k_main.ini"))
	      (SETQ INI_LIST_MAIN (K_LOAD PFAD_MAIN))
	      (SETQ DATA (K_CHECK_ASSOC EINTRAG INI_LIST nil))
	      (SETQ INI_LIST
		     (REVERSE (CONS (LIST EINTRAG DATA) (REVERSE INI_LIST))
		     )
	      )
	      (K_PRINT_DATEI PFAD INI_LIST)
       )
     )
  )
  (IF (GETVAR "SECURELOAD")
    (K_RESTORE_VAR "SECURELOAD")
  )
  DATA
)
(DEFUN K_GET_INI (EINTRAG DATEIPFAD / DATA INI_LIST)
  (vlax-ldata-delete
    (vla-Item (vla-get-Layers (K_AC-DOC)) "0")
    "k_ini"
  )
  (K_INI_UPDATE)
  (SETQ
    DATA (K_CHECK_ASSOC
	   EINTRAG
	   (MAPCAR (QUOTE (LAMBDA (DATA)
			    (IF	(= (TYPE (CAR DATA)) (QUOTE LIST))
			      (CONS (CAAR DATA) (CDR DATA))
			      DATA
			    )
			  )
		   )
		   INI_LIST
	   )
	   nil
	 )
  )
  DATA
)
(DEFUN K_GET_INTERFACE_OBJECT nil
  (vla-GetInterfaceObject
    (vlax-get-acad-object)
    (STRCAT "ObjectDBX.AxDbDocument."
	    (SUBSTR (GETVAR (QUOTE ACADVER)) 1 2)
    )
  )
)
(DEFUN K_GET_MERKLISTE (NAME / WERT)
  (IF (ASSOC NAME K_MERKLISTE)
    (SETQ WERT (NTH 1 (ASSOC NAME K_MERKLISTE)))
  )
  WERT
)
(DEFUN K_GET_SUBOBJ (ENT_NAME / DATA_LIST)
  (SETQ ENT_NAME (K_->ENT_NAME ENT_NAME))
  (COND	((AND (= (CDR (ASSOC 0 (ENTGET ENT_NAME))) "POLYLINE")
	      (= (CDR (ASSOC 66 (ENTGET ENT_NAME))) 1)
	 )
	 (SETQ ENT_NAME (ENTNEXT ENT_NAME))
	 (WHILE	(/= (CDR (ASSOC 0 (ENTGET ENT_NAME))) "SEQEND")
	   (SETQ DATA_LIST (CONS (ENTGET ENT_NAME) DATA_LIST))
	   (SETQ ENT_NAME (ENTNEXT ENT_NAME))
	 )
	)
	((AND (= (CDR (ASSOC 0 (ENTGET ENT_NAME))) "INSERT")
	      (= (CDR (ASSOC 66 (ENTGET ENT_NAME))) 1)
	 )
	 (SETQ ENT_NAME (ENTNEXT ENT_NAME))
	 (WHILE	(/= (CDR (ASSOC 0 (ENTGET ENT_NAME))) "SEQEND")
	   (SETQ DATA_LIST (CONS (ENTGET ENT_NAME) DATA_LIST))
	   (SETQ ENT_NAME (ENTNEXT ENT_NAME))
	 )
	)
  )
  (REVERSE DATA_LIST)
)
(DEFUN K_GET_USERPATH (START_SUCHPFAD NAME / PFAD_LIST SUCHPFAD)
  (FINDFILE (STRCAT (K_GET-INI-DIR START_SUCHPFAD) NAME))
)
(DEFUN K_INI_UPDATE (/ DATEIPFAD GLOBAL_PFAD MAIN_PFAD PROJEKT_PFAD Z)
  (DEFUN K_TIMESTRING (FILE)
    (APPLY (QUOTE STRCAT)
	   (MAPCAR (QUOTE (LAMBDA (Z) (K_STELLENZAHL (ITOA Z) 4)))
		   (K_DEL-NTH (VL-FILE-SYSTIME FILE) 2)
	   )
    )
  )
  (IF (OR (NOT (SETQ INI_LIST (K_GET_MERKLISTE "k_ini")))
	  (NOT (= (K_GET_MERKLISTE "k_ini_update") "stop"))
      )
    (IF	(SETQ MAIN_PFAD (FINDFILE "k_main.ini"))
      (PROGN
	(IF (SETQ GLOBAL_PFAD (FINDFILE "k_global.ini"))
	  (PROGN (K_CHECK_NEU_INI MAIN_PFAD GLOBAL_PFAD))
	  (K_PRINT_DATEI
	    (STRCAT (K_PATHSLASH (VL-FILENAME-DIRECTORY MAIN_PFAD) nil)
		    "k_global.ini"
	    )
	    (VL-REMOVE-IF
	      (QUOTE (LAMBDA (EINTRAG) (NULL (CADR EINTRAG))))
	      (K_LOAD MAIN_PFAD)
	    )
	  )
	)
	(IF (SETQ PROJEKT_PFAD (K_GET_USERPATH DATEIPFAD "k_projekt.ini"))
	  (PROGN (K_CHECK_NEU_INI GLOBAL_PFAD PROJEKT_PFAD))
	  (K_PRINT_DATEI
	    (SETQ PROJEKT_PFAD
		   (STRCAT (K_NEU_USERPATH DATEIPFAD)
			   "k_projekt.ini"
		   )
	    )
	    (VL-REMOVE-IF
	      (QUOTE (LAMBDA (EINTRAG) (NULL (CADR EINTRAG))))
	      (K_LOAD GLOBAL_PFAD)
	    )
	  )
	)
	(SETQ INI_LIST (K_LOAD PROJEKT_PFAD))
	(K_PUT_MERKLISTE "k_ini" INI_LIST)
      )
      (ALERT "keine INI-Datei \"k_main.ini\" vorhanden")
    )
  )
  INI_LIST
)
(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_ISXREF	(ENT_NAME)
  (SETQ
    ENT_DATA (ENTGET (SETQ
		       ENT_NAME	(K_->ENT_NAME
				  (SETQ OBJ_NAME (K_->OBJ_NAME ENT_NAME))
				)
		     )
	     )
  )
  (COND	((= (CDR (ASSOC 0 ENT_DATA)) "LAYER")
	 (K_BIT (CDR (ASSOC 70 ENT_DATA)) 16)
	)
	((= (CDR (ASSOC 0 ENT_DATA)) "BLOCK_RECORD")
	 (K_IS (vla-get-IsXRef OBJ_NAME))
	)
	(T nil)
  )
)
(DEFUN K_JA_NEIN (TEXT / K_END_JA_NEIN_OK K_JA_NEIN_ID)
  (DEFUN K_END_JA_NEIN (WERT)
    (SETQ K_END_JA_NEIN_OK WERT)
    (DONE_DIALOG)
  )
  (SETQ K_JA_NEIN_ID (LOAD_DIALOG "k_sym2schema.dcl"))
  (IF (NOT (NEW_DIALOG "k_ja_nein" K_JA_NEIN_ID))
    (EXIT)
  )
  (SET_TILE "text" TEXT)
  (ACTION_TILE "accept" "(k_end_ja_nein 1)")
  (ACTION_TILE "cancel" "(k_end_ja_nein 0)")
  (START_DIALOG)
  (UNLOAD_DIALOG K_JA_NEIN_ID)
  (K_IS K_END_JA_NEIN_OK)
)
(DEFUN K_LOAD (PFAD / LISTE)
  (IF (NOT
	(VL-CATCH-ALL-ERROR-P
	  (SETQ
	    LISTE (VL-CATCH-ALL-APPLY (QUOTE LOAD) (LIST PFAD "ERROR"))
	  )
	)
      )
    LISTE
    nil
  )
)
(DEFUN K_MK_DRIVES_LIST	(/	       VLA-FILEOBJ   DRIVES
			 DRIVE	       DRIVEPATH     DRIVES_LIST
			 VOLUMENAME    SERIALNUMBER
			)
  (VL-LOAD-COM)
  (SETQ VLA-FILEOBJ (vlax-create-object "Scripting.FileSystemObject"))
  (SETQ DRIVES (vlax-get-property VLA-FILEOBJ (QUOTE DRIVES)))
  (VLAX-FOR DRIVE DRIVES
    (SETQ DRIVEPATH (vlax-get-property DRIVE (QUOTE PATH)))
    (SETQ DRIVETYPE (vlax-get-property DRIVE (QUOTE DRIVETYPE)))
    (IF	(= (TYPE DRIVETYPE) (QUOTE variant))
      (SETQ DRIVETYPE (variant-value DRIVETYPE))
    )
    (COND ((= DRIVETYPE 0) (SETQ DRIVETYPE "Unbekannt"))
	  ((= DRIVETYPE 1) (SETQ DRIVETYPE "Austauschbar"))
	  ((= DRIVETYPE 2) (SETQ DRIVETYPE "Fest"))
	  ((= DRIVETYPE 3) (SETQ DRIVETYPE "Netzwerk"))
	  ((= DRIVETYPE 4) (SETQ DRIVETYPE "CD-ROM"))
	  ((= DRIVETYPE 5) (SETQ DRIVETYPE "RAM-Laufwerk"))
    )
    (IF	(VL-CATCH-ALL-ERROR-P
	  (SETQ	VOLUMENAME
		 (VL-CATCH-ALL-APPLY
		   (QUOTE vlax-get-property)
		   (LIST DRIVE (QUOTE VOLUMENAME))
		 )
	  )
	)
      (SETQ VOLUMENAME "")
    )
    (IF	(VL-CATCH-ALL-ERROR-P
	  (SETQ	SERIALNUMBER
		 (VL-CATCH-ALL-APPLY
		   (QUOTE vlax-get-property)
		   (LIST DRIVE (QUOTE SERIALNUMBER))
		 )
	  )
	)
      (SETQ SERIALNUMBER nil)
    )
    (SETQ DRIVES_LIST
	   (APPEND DRIVES_LIST
		   (LIST (LIST (STRCASE DRIVEPATH)
			       DRIVETYPE
			       VOLUMENAME
			       SERIALNUMBER
			 )
		   )
	   )
    )
  )
  DRIVES_LIST
)
(DEFUN K_MK_SUBSTR_LIST
       (TEXT FILTER ENTF / F_LIST ERGEBNIS_LIST POS START)
  (IF (WCMATCH TEXT FILTER)
    (PROGN
      (SETQ F_LIST (K_WCMATCH_POS TEXT FILTER)
	    POS	   1
      )
      (FOREACH TEIL F_LIST
	(SETQ START (NTH 0 TEIL))
	(IF (> START POS)
	  (SETQ	ERGEBNIS_LIST
		 (CONS (LIST POS (- START POS)) ERGEBNIS_LIST)
	  )
	  (SETQ ERGEBNIS_LIST (CONS (LIST POS 0) ERGEBNIS_LIST))
	)
	(IF ENTF
	  (SETQ ERGEBNIS_LIST (CONS TEIL ERGEBNIS_LIST))
	)
	(SETQ POS (+ START (NTH 1 TEIL)))
      )
      (IF
	(<= (SETQ START (+ (NTH 0 (LAST F_LIST)) (NTH 1 (LAST F_LIST))))
	    (STRLEN TEXT)
	)
	 (SETQ ERGEBNIS_LIST (CONS (LIST START nil) ERGEBNIS_LIST))
      )
      (VL-REMOVE-IF
	(QUOTE (LAMBDA (DUMMY) (= (CADR DUMMY) 0)))
	(REVERSE ERGEBNIS_LIST)
      )
    )
    (QUOTE ((1 nil)))
  )
)
(DEFUN K_NEU_USERPATH (DATEIPFAD  /	     PFAD	ORDNER_LIST
		       DATEI	  ZEILE	     PATH_LIST	OK
		       ORDNER	  SUCHPFAD   DAT_PFAD
		      )
  (K_PATHSLASH (K_GET-INI-DIR DATEIPFAD) nil)
)
(DEFUN K_ODBX_CONSTRUCT	nil
  (vla-GetInterfaceObject
    (vlax-get-acad-object)
    (STRCAT "ObjectDBX.AxDbDocument."
	    (SUBSTR (GETVAR (QUOTE ACADVER)) 1 2)
    )
  )
)
(DEFUN K_PATHBACKSLASH (PFAD REMOVE)
  (IF (AND PFAD (/= PFAD ""))
    (PROGN
      (SETQ PFAD (K_TXT-SUBST PFAD "/" "\\"))
      (COND ((AND REMOVE (= (SUBSTR PFAD (STRLEN PFAD) 1) "\\"))
	     (SETQ PFAD (SUBSTR PFAD 1 (1- (STRLEN PFAD))))
	    )
	    ((AND (NOT REMOVE) (/= (SUBSTR PFAD (STRLEN PFAD) 1) "\\"))
	     (SETQ PFAD (STRCAT PFAD "\\"))
	    )
      )
    )
  )
  PFAD
)
(DEFUN K_PATHSLASH (PFAD REMOVE)
  (IF (AND PFAD (/= PFAD ""))
    (PROGN
      (SETQ PFAD (K_TXT-SUBST PFAD "\\" "/"))
      (COND ((AND REMOVE (= (SUBSTR PFAD (STRLEN PFAD) 1) "/"))
	     (SETQ PFAD (SUBSTR PFAD 1 (1- (STRLEN PFAD))))
	    )
	    ((AND (NOT REMOVE) (/= (SUBSTR PFAD (STRLEN PFAD) 1) "/"))
	     (SETQ PFAD (STRCAT PFAD "/"))
	    )
      )
    )
  )
  PFAD
)
(DEFUN K_PAUSE (ZEIT / START)
  (SETQ START (+ (GETVAR "date") (/ ZEIT 1.0e+08)))
  (WHILE (< (GETVAR "date") START))
)
(DEFUN K_PFADWAHL (WAHLPFAD	       TEXT
		   EXT_LIST	       CHECK
		   MULTI	       /
		   WAHLPFAD_NEU	       DRIVE_LIST
		   PFAD		       PFAD_LIST
		   K_PFADWAHL_ID       K_PFADWAHL_OK
		   WERT		       WAHLFILE_NEU_LIST
		   K_END_PFADWAHL      K_PFADWAHL_DRIVE_LIST
		   K_PFADWAHL_PFAD_LIST
		   K_PFADWAHL_ZEIGEN   K_PFADWAHL_FILE_LIST
		   K_PFADWAHL_CHECK    K_PFADWAHL_ORDNER_NEU
		   K_PFADWAHL_WAHLPFAD
		  )
  (DEFUN K_END_PFADWAHL	(WERT)
    (SETQ K_PFADWAHL_OK WERT)
    (DONE_DIALOG)
  )
  (DEFUN K_PFADWAHL_DRIVE_LIST nil
    (SETQ WAHLPFAD_NEU
	   (K_PATHSLASH
	     (NTH (ATOI (GET_TILE "drive_list")) DRIVE_LIST)
	     nil
	   )
    )
    (K_PFADWAHL_ZEIGEN WAHLPFAD_NEU)
  )
  (DEFUN K_PFADWAHL_PFAD_LIST (/ EXTENSION PFAD)
    (IF	(= $REASON 4)
      (PROGN
	(SETQ WAHLPFAD_LIST nil)
	(SETQ PFAD (NTH (ATOI (GET_TILE "pfad_list")) PFAD_LIST))
	(IF (EQUAL PFAD "..")
	  (IF
	    (NOT
	      (EQUAL (SETQ WAHLPFAD_DUMMY (K_CUT_PFADLAST WAHLPFAD_NEU))
		     ""
	      )
	    )
	     (SETQ WAHLPFAD_NEU (K_PATHSLASH WAHLPFAD_DUMMY nil))
	  )
	  (PROGN (SETQ WAHLPFAD_NEU
			(K_PATHSLASH
			  (VL-STRING-SUBST
			    "/"
			    "//"
			    (STRCAT WAHLPFAD_NEU "/" PFAD)
			  )
			  nil
			)
		 )
	  )
	)
	(K_PFADWAHL_ZEIGEN WAHLPFAD_NEU)
      )
      (SETQ WAHLPFAD_LIST
	     (MAPCAR
	       (QUOTE (LAMBDA (N)
			(VL-STRING-SUBST
			  "/"
			  "//"
			  (STRCAT WAHLPFAD_NEU
				  "/"
				  (NTH N PFAD_LIST)
			  )
			)
		      )
	       )
	       (EVAL
		 (READ (STRCAT "'(" (GET_TILE "pfad_list") ")")
		 )
	       )
	     )
      )
    )
  )
  (DEFUN K_PFADWAHL_ZEIGEN (PFAD)
    (SETQ PFAD_LIST (VL-DIRECTORY-FILES PFAD nil -1)
	  PFAD_LIST (K_VL-SORT PFAD_LIST (QUOTE <))
    )
    (IF	(AND (NOT (MEMBER (STRCASE PFAD) DRIVE_LIST))
	     (NOT (MEMBER ".." PFAD_LIST))
	)
      (SETQ PFAD_LIST (CONS ".." PFAD_LIST))
    )
    (SETQ PFAD_LIST (VL-REMOVE "." PFAD_LIST))
    (IF	EXT_LIST
      (PROGN (SETQ FILE_LIST (LIST))
	     (FOREACH EXT EXT_LIST
	       (SETQ FILE_LIST
		      (APPEND FILE_LIST (VL-DIRECTORY-FILES PFAD EXT 1))
	       )
	     )
	     (SETQ FILE_LIST (K_VL-SORT FILE_LIST (QUOTE <)))
      )
    )
    (SET_TILE "check" "")
    (IF	EXT_LIST
      (PROGN (START_LIST "file_list")
	     (MAPCAR (QUOTE ADD_LIST) FILE_LIST)
	     (END_LIST)
      )
    )
    (START_LIST "pfad_list")
    (MAPCAR (QUOTE ADD_LIST) PFAD_LIST)
    (END_LIST)
    (SET_TILE "wahlpfad" PFAD)
  )
  (DEFUN K_PFADWAHL_FILE_LIST nil
    (SETQ WAHLPFAD_LIST nil)
    (SET_TILE "pfad_list" "")
    (SETQ WAHL		    (READ (STRCAT "(" (GET_TILE "file_list") ")"))
	  WAHLFILE_NEU_LIST (MAPCAR
			      (QUOTE (LAMBDA (DUMMY) (NTH DUMMY FILE_LIST)))
			      WAHL
			    )
    )
    (K_PFADWAHL_CHECK CHECK)
    (IF	(= $REASON 4)
      (K_END_PFADWAHL 1)
    )
  )
  (DEFUN K_PFADWAHL_CHECK (CHECK)
    (IF	(AND CHECK WAHLFILE_NEU)
      (FOREACH WAHLFILE_NEU WAHLFILE_NEU_LIST
	(IF (FINDFILE WAHLFILE_NEU)
	  (SET_TILE "check_txt" "in Supportpfaden")
	  (SET_TILE "check_txt" "nicht in Supportpfaden")
	)
      )
    )
  )
  (DEFUN K_PFADWAHL_ORDNER_NEU (/ PFAD ORDNERNAME)
    (IF	(AND (SETQ ORDNERNAME (K_TXT_INPUT_1 "Verzeichnisname" "" ""))
	     (NOT (EQUAL ORDNERNAME ""))
	)
      (PROGN (SETQ WAHLPFAD_NEU
		    (K_PATHSLASH
		      (STRCAT WAHLPFAD_NEU "/" ORDNERNAME)
		      nil
		    )
	     )
	     (VL-MKDIR WAHLPFAD_NEU)
	     (K_PFADWAHL_ZEIGEN WAHLPFAD_NEU)
      )
    )
  )
  (DEFUN K_PFADWAHL_WAHLPFAD nil
    (SETQ WAHLPFAD     (K_TXT-SUBST (GET_TILE "wahlpfad") "\\" "/")
	  WAHLPFAD_NEU WAHLPFAD
    )
    (K_PFADWAHL_ZEIGEN WAHLPFAD_NEU)
  )
  (SETQ	DRIVE_LIST   (MAPCAR (QUOTE (LAMBDA (DUMMY) (NTH 0 DUMMY)))
			     (K_MK_DRIVES_LIST)
		     )
	WAHLPFAD     (K_TXT-SUBST WAHLPFAD "\\" "/")
	WAHLPFAD_NEU WAHLPFAD
  )
  (IF (AND EXT_LIST (= (TYPE EXT_LIST) (QUOTE STR)))
    (SETQ EXT_LIST (LIST EXT_LIST))
  )
  (SETQ	K_PFADWAHL_DCL
	 (K_TEMP-DCL
	   (LIST "k_pfadwahl : dialog {"
		 "  label = \"Pfadwahl\";"
		 "  key = \"rahmen\";"
		 "  width = 150;"
		 "  : edit_box {"
		 "    key = \"wahlpfad\";"
		 "    label = \"\";"
		 "  }"
		 "  : boxed_row {"
		 "    height = 23;"
		 "    : column {"
		 "      : list_box {"
		 "        key = \"pfad_list\";"
		 "        fixed_width = true;"
		 "        width = 60;"
		 "        fixed_height = true;"
		 "        height = 20;"
		 (IF (AND MULTI EXT_LIST)
		   "        multiple_select = true;"
		   ""
		 )
		 "      }"
		 "      : popup_list {"
		 "        key = \"drive_list\";"
		 "        fixed_height = true;"
		 "        height = 3;"
		 "      }"
		 "    }"
		 "    : column {"
		 "      : list_box {"
		 "        key = \"file_list\";"
		 (IF (AND MULTI EXT_LIST)
		   "        multiple_select = true;"
		   ""
		 )
		 "        fixed_width = true;"
		 "        width = 90;"
		 "        fixed_height = true;"
		 "        height = 20;"
		 "      }"
		 "      : text {"
		 "        label = \"\";"
		 "        key = \"check_txt\";"
		 "        fixed_height = true;"
		 "        height = 3;"
		 "      }"
		 "    }"
		 "  }"
		 "  : row {"
		 "    : button {"
		 "      label = \"OK\";"
		 "      key = \"accept\";"
		 "      is_default = true;"
		 "    }"
		 "    : button {"
		 "      label = \"ABBRUCH\";"
		 "      key = \"cancel\";"
		 "      is_cancel = true;"
		 "    }"
		 "    : button {"
		 "      label = \"Check\";"
		 "      key = \"check\";"
		 "    }"
		 "    : button {"
		 "      label = \"Ordner anlegen\";"
		 "      key = \"ordner_neu\";"
		 "    }"
		 "  }"
		 "}"
		 "k_ok_cancel  : column {"
		 "  children_alignment = left;"
		 "  : row {"
		 "    fixed_width = true;"
		 "    : button {"
		 "      key = \"accept\";"
		 "      label = \"OK\";"
		 "      is_default = true;"
		 "      fixed_width = true;"
		 "    }"
		 "    : button {"
		 "      key = \"cancel\";"
		 "      label = \"Abbruch\";"
		 "      is_cancel = true;"
		 "      fixed_width = true;"
		 "    }"
		 "  }"
		 "}"
	   )
	 )
  )
  (SETQ K_PFADWAHL_ID (LOAD_DIALOG K_PFADWAHL_DCL))
  (VL-FILE-DELETE K_PFADWAHL_DCL)
  (IF (NOT (NEW_DIALOG "k_pfadwahl" K_PFADWAHL_ID))
    (EXIT)
  )
  (K_PFADWAHL_ZEIGEN WAHLPFAD_NEU)
  (START_LIST "drive_list")
  (MAPCAR (QUOTE ADD_LIST) DRIVE_LIST)
  (END_LIST)
  (IF (VL-POSITION (SUBSTR WAHLPFAD 1 2) DRIVE_LIST)
    (SET_TILE "drive_list"
	      (ITOA (VL-POSITION (SUBSTR WAHLPFAD 1 2) DRIVE_LIST))
    )
  )
  (IF EXT_LIST
    (PROGN (ACTION_TILE "file_list" "(k_pfadwahl_file_list)")
	   (ACTION_TILE "check" "(k_pfadwahl_check t)")
    )
    (PROGN (MODE_TILE "file_list" 1) (MODE_TILE "check" 1))
  )
  (IF TEXT
    (SET_TILE "rahmen" TEXT)
  )
  (ACTION_TILE "wahlpfad" "(k_pfadwahl_wahlpfad)")
  (ACTION_TILE "ordner_neu" "(k_pfadwahl_ordner_neu)")
  (ACTION_TILE "drive_list" "(k_pfadwahl_drive_list)")
  (ACTION_TILE "pfad_list" "(k_pfadwahl_pfad_list)")
  (ACTION_TILE "accept" "(k_end_pfadwahl 1)")
  (ACTION_TILE "cancel" "(k_end_pfadwahl 0)")
  (START_DIALOG)
  (UNLOAD_DIALOG K_PFADWAHL_ID)
  (IF (= K_PFADWAHL_OK 1)
    (IF	WAHLFILE_NEU_LIST
      (SETQ WERT (CONS WAHLPFAD_NEU WAHLFILE_NEU_LIST))
      (SETQ WERT WAHLPFAD_NEU)
    )
    (SETQ WERT nil)
  )
  WERT
)
(DEFUN K_PFADWAHL_ZUSAMMENBAUEN	(LISTE)
  (MAPCAR (QUOTE
	    (LAMBDA (NAME) (STRCAT (K_PATHSLASH (CAR LISTE) nil) NAME))
	  )
	  (CDR LISTE)
  )
)
(DEFUN K_PRINT_DATEI (PFAD LISTE / DATEI)
  (IF PFAD
    (PROGN (SETQ DATEI (OPEN PFAD "w"))
	   (WRITE-LINE "(quote (" DATEI)
	   (FOREACH DATA LISTE (PRINT DATA DATEI))
	   (WRITE-LINE "" DATEI)
	   (WRITE-LINE "))" DATEI)
	   (CLOSE DATEI)
    )
  )
)
(DEFUN K_PROGRAMMPOSITION (/ PFAD ACADOBJECT MENUGROUPS NAME)
  (SETQ	ACADOBJECT (vlax-get-acad-object)
	MENUGROUPS (vla-get-MenuGroups ACADOBJECT)
  )
  (FOREACH EACH	(K_COLLECTION->LIST MENUGROUPS)
    (SETQ NAME (vla-get-Name EACH))
    (IF	(EQUAL NAME "K_MAIN")
      (SETQ PFAD (vla-get-MenuFileName EACH))
    )
  )
  (IF PFAD
    (SETQ PFAD (K_PATHBACKSLASH
		 (VL-FILENAME-DIRECTORY (VL-FILENAME-DIRECTORY PFAD))
		 nil
	       )
    )
  )
  PFAD
)
(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_DATA (OBJ_NAME	 BEZ	       DATA
		   APP		 /	       ATT_LIST
		   BEZ_ZÄHLER	 DAT_LIST      DATA_LIST
		   DYN_LIST	 OBJ	       PROP
		   XDATA	 XTYPE	       XVALUE
		   ZIEL_ATT	 K_COUNTER_DIALOG_NEU
		   K_FIND_RAUM_CHK	       K_GET_DATA_WORK
		  )
  (WHILE (NOT APP) (SETQ APP "KRAUS"))
  (SETQ BEZ_ZÄHLER 0)
  (IF (AND (= (TYPE BEZ) (QUOTE LIST)) DATA)
    (SETQ BEZ_ZÄHLER (NTH 1 BEZ)
	  BEZ	     (NTH 0 BEZ)
    )
    (SETQ BEZ_ZÄHLER 0)
  )
  (IF (AND (= (TYPE BEZ) (QUOTE LIST)) (NOT DATA))
    (SETQ BEZ_LIST  (MAPCAR (QUOTE CAR) BEZ)
	  DATA_LIST (MAPCAR (QUOTE CADR) BEZ)
    )
    (SETQ BEZ_LIST  (LIST BEZ)
	  DATA_LIST (LIST DATA)
    )
  )
  (SETQ OBJ_NAME (K_->OBJ_NAME OBJ_NAME))
  (MAPCAR
    (QUOTE
      (LAMBDA (BEZ DATA / DATA_LIST DAT_LIST)
	(IF BEZ
	  (IF (AND (vlax-property-available-p OBJ_NAME BEZ) DATA)
	    (PROGN
	      (IF
		(SETQ DAT (K_DATA->PROPERTY-CONVERT OBJ_NAME BEZ DATA))
		 (IF (VL-CATCH-ALL-ERROR-P
		       (VL-CATCH-ALL-APPLY
			 (QUOTE setpropertyvalue)
			 (LIST (K_->ENT_NAME OBJ_NAME) BEZ DAT)
		       )
		     )
		   (EVAL
		     (LIST (READ (STRCAT "vla-put-" BEZ)) OBJ_NAME DAT)
		   )
		 )
	      )
	    )
	    (IF
	      (AND (vlax-property-available-p OBJ_NAME "isdynamicblock")
		   (= (vla-get-IsDynamicBlock OBJ_NAME) :vlax-true)
		   (vlax-method-applicable-p
		     OBJ_NAME
		     (QUOTE GETDYNAMICBLOCKPROPERTIES)
		   )
		   (SETQ PROP
			  (CADR
			    (ASSOC
			      BEZ
			      (VL-REMOVE
				(QUOTE nil)
				(MAPCAR
				  (QUOTE
				    (LAMBDA (PROP)
				      (IF
					(= (vla-get-Show PROP) :vlax-true)
					 (LIST (vla-get-PropertyName PROP)
					       PROP
					 )
				      )
				    )
				  )
				  (vlax-invoke
				    OBJ_NAME
				    (QUOTE GETDYNAMICBLOCKPROPERTIES)
				  )
				)
			      )
			    )
			  )
		   )
	      )
	       (K_DATA->PROP PROP DATA)
	       (IF
		 (AND (vlax-property-available-p OBJ_NAME "hasattributes")
		      (= (vla-get-HasAttributes OBJ_NAME) :vlax-true)
		      (ASSOC (STRCASE BEZ)
			     (SETQ ATT_LIST
				    (MAPCAR
				      (QUOTE
					(LAMBDA	(OBJ)
					  (LIST
					    (STRCASE (vla-get-TagString OBJ))
					    OBJ
					  )
					)
				      )
				      (vlax-invoke
					OBJ_NAME
					(QUOTE GETATTRIBUTES)
				      )
				    )
			     )
		      )
		 )
		  (IF (SETQ ZIEL_ATT
			     (NTH BEZ_ZÄHLER
				  (VL-REMOVE-IF-NOT
				    (QUOTE (LAMBDA (ATT_DATA)
					     (OR (= (NTH 0 ATT_DATA) BEZ)
						 (= (NTH 0 ATT_DATA)
						    (STRCASE BEZ)
						 )
					     )
					   )
				    )
				    ATT_LIST
				  )
			     )
		      )
		    (IF	DATA
		      (vla-put-TextString (NTH 1 ZIEL_ATT) DATA)
		      (vla-put-TextString (NTH 1 ZIEL_ATT) "")
		    )
		  )
		  (PROGN
		    (IF	(NOT (TBLSEARCH "appid" APP))
		      (IF (= (REGAPP APP) nil)
			(PRINT (STRCAT "kann " APP " nicht registrieren"))
		      )
		    )
		    (IF	(AND (NOT (VL-CATCH-ALL-ERROR-P
				    (VL-CATCH-ALL-APPLY
				      (QUOTE vla-GetXData)
				      (LIST OBJ_NAME
					    APP
					    (QUOTE XTYPE)
					    (QUOTE XDATA)
				      )
				    )
				  )
			     )
			     XTYPE
			     XDATA
			)
		      (PROGN (SETQ DAT_LIST
				    (APPEND
				      DAT_LIST
				      (GATHER
					(CDR (MAPCAR
					       (QUOTE vlax-variant-value)
					       (vlax-safearray->list XDATA)
					     )
					)
					2
				      )
				    )
			     )
		      )
		    )
		    (IF	(ASSOC BEZ DAT_LIST)
		      (IF DATA
			(SETQ DAT_LIST (SUBST (LIST BEZ DATA)
					      (ASSOC BEZ DAT_LIST)
					      DAT_LIST
				       )
			)
			(SETQ DAT_LIST
			       (VL-REMOVE nil
					  (SUBST nil
						 (ASSOC BEZ DAT_LIST)
						 DAT_LIST
					  )
			       )
			)
		      )
		      (IF DATA
			(SETQ DAT_LIST (APPEND DAT_LIST
					       (LIST (LIST BEZ DATA))
				       )
			)
		      )
		    )
		    (SETQ DAT_LIST (APPLY (QUOTE APPEND) DAT_LIST))
		    (SETQ XTYPE	(vlax-make-safearray
				  vlax-vbInteger
				  (CONS 0 (LENGTH DAT_LIST))
				)
		    )
		    (SETQ XVALUE (vlax-make-safearray
				   vlax-vbVariant
				   (CONS 0 (LENGTH DAT_LIST))
				 )
		    )
		    (vlax-safearray-fill
		      XTYPE
		      (CONS
			1001
			(MAPCAR
			  (QUOTE
			    (LAMBDA (DUMMY)
			      (COND ((= (TYPE DUMMY) (QUOTE STR)) 1000)
				    ((= (TYPE DUMMY) (QUOTE INT)) 1070)
				    ((= (TYPE DUMMY) (QUOTE REAL)) 1040)
				    (T 1000)
			      )
			    )
			  )
			  DAT_LIST
			)
		      )
		    )
		    (vlax-safearray-fill XVALUE (CONS APP DAT_LIST))
		    (vla-SetXData
		      OBJ_NAME
		      (vlax-make-variant XTYPE)
		      (vlax-make-variant XVALUE)
		    )
		  )
	       )
	    )
	  )
	)
      )
    )
    BEZ_LIST
    DATA_LIST
  )
  (FOREACH V (QUOTE (OBJ_NAME BEZ	    DATA	  APP
			      ATT_LIST	    BEZ_ZÄHLER	  DAT_LIST
			      DATA_LIST	    DYN_LIST	  OBJ
			      PROP	    XDATA	  XTYPE
			      XVALUE	    ZIEL_ATT
			      K_COUNTER_DIALOG_NEU
			      K_FIND_RAUM_CHK
			      K_GET_DATA_WORK
			     )
	     )
    (SETQ V nil)
  )
  (PRINC)
)
(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_P_TWIST (P PX WX / PZ PXZ)
  (SETQ	PZ  (CADDR P)
	PXZ (CADDR PX)
  )
  (SETQ	P  (K_3D->2D P)
	PX (K_3D->2D PX)
  )
  (VL-REMOVE (QUOTE nil)
	     (APPEND (POLAR PX (+ (ANGLE PX P) WX) (DISTANCE PX P))
		     (LIST PZ)
	     )
  )
)
(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_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_STELLENZAHL (TXT STELLEN)
  (WHILE (< (STRLEN TXT) STELLEN) (SETQ TXT (STRCAT "0" TXT)))
  TXT
)
(DEFUN K_TEMP-DCL (DATA_LIST / PATH FILE)
  (COND	((SETQ FILE (OPEN (SETQ PATH (VL-FILENAME-MKTEMP "tmp~.dcl")) "w"))
	 (FOREACH ZEILE DATA_LIST (WRITE-LINE ZEILE FILE))
	 (CLOSE FILE)
	 PATH
	)
  )
)
(DEFUN K_TXT-SUBST (TXT ALT_LIST NEU_LIST)
  (IF (NOT (LISTP ALT_LIST))
    (SETQ ALT_LIST (LIST ALT_LIST))
  )
  (IF (NOT (LISTP NEU_LIST))
    (SETQ NEU_LIST (LIST NEU_LIST))
  )
  (WHILE (> (LENGTH ALT_LIST)
	    (MIN (LENGTH ALT_LIST) (LENGTH NEU_LIST))
	 )
    (SETQ ALT_LIST (I-CDR ALT_LIST))
  )
  (WHILE (> (LENGTH NEU_LIST)
	    (MIN (LENGTH ALT_LIST) (LENGTH NEU_LIST))
	 )
    (SETQ NEU_LIST (I-CDR NEU_LIST))
  )
  (MAPCAR
    (QUOTE
      (LAMBDA (ALT NEU)
	(WHILE
	  (NOT (EQUAL TXT (SETQ TXT (VL-STRING-SUBST NEU ALT TXT))))
	)
      )
    )
    ALT_LIST
    NEU_LIST
  )
  TXT
)
(DEFUN K_TXT_INPUT_1 (RAHMENTEXT BEZ1 TXT1 / K_TXT_INPUT_1_ID)
  (DEFUN K_END_TXT_INPUT_1 (WERT)
    (COND ((AND (= $REASON 1) (= WERT 2))
	   (SETQ TXT1 (GET_TILE "txt_1"))
	   (DONE_DIALOG)
	  )
	  ((AND (= $REASON 1) (= WERT 1))
	   (SETQ TXT1 (GET_TILE "txt_1"))
	   (DONE_DIALOG)
	  )
	  ((AND (= $REASON 1) (= WERT 1)) (DONE_DIALOG))
    )
  )
  (SETQ K_TXT_INPUT_1_ID (LOAD_DIALOG "k_sym2schema.dcl"))
  (IF (NOT (NEW_DIALOG "k_txt_input_1" K_TXT_INPUT_1_ID))
    (EXIT)
  )
  (SET_TILE "rahmentext" RAHMENTEXT)
  (SET_TILE "bez_1" BEZ1)
  (SET_TILE "txt_1" TXT1)
  (MODE_TILE "txt_1" 2)
  (ACTION_TILE "txt_1" "(k_end_txt_input_1 2)")
  (ACTION_TILE "accept" "(k_end_txt_input_1 1)")
  (ACTION_TILE "cancel" "(k_end_txt_input_1 0)")
  (START_DIALOG)
  (UNLOAD_DIALOG K_TXT_INPUT_1_ID)
  TXT1
)
(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 K_WCMATCH_POS (TEXT FILTER / START LISTE INC)
  (DEFUN K_WCMATCH_POS_WORK (TEXT / LISTE N TXT)
    (SETQ N (STRLEN TEXT))
    (WHILE (AND	(/= (SUBSTR TEXT 1 N) "")
		(WCMATCH (SUBSTR TEXT 1 N) FILTER)
	   )
      (SETQ N (1- N))
    )
    (SETQ TXT (SUBSTR TEXT 1 (1+ N))
	  N   1
    )
    (WHILE (AND (<= N (STRLEN TEXT)) (WCMATCH (SUBSTR TXT N) FILTER))
      (SETQ N (1+ N))
    )
    (SETQ START	(1- N)
	  INC	(+ INC START)
	  LISTE	(LIST (LIST INC (STRLEN (SUBSTR TXT START))))
	  INC	(+ INC (1- (STRLEN (SUBSTR TXT START))))
    )
    (IF	(AND (/= ""
		 (SETQ
		   TEXT	(SUBSTR TEXT (+ START (STRLEN (SUBSTR TXT START))))
		 )
	     )
	     (WCMATCH TEXT FILTER)
	)
      (SETQ LISTE (APPEND LISTE (K_WCMATCH_POS_WORK TEXT)))
    )
    LISTE
  )
  (IF (= (STRLEN TEXT) 0)
    (SETQ LISTE (LIST (LIST 1 0)))
    (IF	(= FILTER "*")
      (SETQ LISTE (LIST (LIST 1 (STRLEN TEXT))))
      (PROGN (SETQ INC 0)
	     (IF (WCMATCH TEXT FILTER)
	       (PROGN (SETQ LISTE (K_WCMATCH_POS_WORK TEXT)))
	     )
      )
    )
  )
  LISTE
)
(DEFUN K_ZERLEGE_ART (ZEILE TRENNER ART / LISTE)
  (SETQ
    LISTE (VL-REMOVE ""
		     (K_ZERLEGE_TEXT ZEILE (STRCAT "*" TRENNER "*") 2)
	  )
  )
  (COND	((= ART "int") (SETQ LISTE (MAPCAR (QUOTE ATOI) LISTE)))
	((= ART "real") (SETQ LISTE (MAPCAR (QUOTE ATOF) LISTE)))
	((= ART "str") (SETQ LISTE LISTE))
	(T nil)
  )
  LISTE
)
(DEFUN K_ZERLEGE_TEXT (TEXT FILTER RÜCKGABE / TEIL)
  (COND
    ((= RÜCKGABE 0)
     (MAPCAR (QUOTE
	       (LAMBDA (TEIL) (SUBSTR TEXT (NTH 0 TEIL) (NTH 1 TEIL)))
	     )
	     (K_MK_SUBSTR_LIST TEXT FILTER T)
     )
    )
    ((= RÜCKGABE 1)
     (MAPCAR (QUOTE
	       (LAMBDA (TEIL) (SUBSTR TEXT (NTH 0 TEIL) (NTH 1 TEIL)))
	     )
	     (K_WCMATCH_POS TEXT FILTER)
     )
    )
    ((= RÜCKGABE 2)
     (MAPCAR (QUOTE
	       (LAMBDA (TEIL) (SUBSTR TEXT (NTH 0 TEIL) (NTH 1 TEIL)))
	     )
	     (K_MK_SUBSTR_LIST TEXT FILTER nil)
     )
    )
    ((= RÜCKGABE 3)
     (MAPCAR (QUOTE (LAMBDA (TEIL) (LIST (NTH 0 TEIL) (NTH 1 TEIL))))
	     (K_MK_SUBSTR_LIST TEXT FILTER T)
     )
    )
    ((= RÜCKGABE 4)
     (MAPCAR (QUOTE (LAMBDA (TEIL) (LIST (NTH 0 TEIL) (NTH 1 TEIL))))
	     (K_WCMATCH_POS TEXT FILTER)
     )
    )
    ((= RÜCKGABE 5)
     (MAPCAR (QUOTE (LAMBDA (TEIL) (LIST (NTH 0 TEIL) (NTH 1 TEIL))))
	     (K_MK_SUBSTR_LIST TEXT FILTER nil)
     )
    )
  )
)
(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 N-CAR (N LST / RES)
  (REPEAT (MIN N (LENGTH LST))
    (SETQ RES (CONS (CAR LST) RES)
	  LST (CDR LST)
    )
  )
  (REVERSE RES)
)
(DEFUN N-CDR (N LST) (REPEAT N (SETQ LST (CDR LST))))
(DEFUN _< (E0 E1 /) (< (CAR E0) (CAR E1)))

(defun c:k_sym2schema (/
		      )
;;;  per ODBX Blöcke aus anderen Plänen importieren, Schematisch anordnen und Daten übernehmen
  (defun k_sym2schema_get-data (/)
    (setq n (length obj_list))
    (setq
      dat
       (mapcar
	 '(lambda (obj)
	    (k_counter_liste
	      "show"
	      "Objektdaten erfassen"
	      (setq n (1- n))
	      show_list
	    )
	    (vl-remove
	      nil
	      (list
		(list "Blockname" (vla-get-EffectiveName obj))
		(list "Layer" (vla-get-layer obj))
		(list "Blockskalierung"
		      (list (vla-get-XScaleFactor obj)
			    (vla-get-YScaleFactor obj)
			    (vla-get-ZScaleFactor obj)
		      )
		)
		(if (and (vlax-property-available-p obj "hasattributes")
			 (= (vla-get-hasattributes obj) :vlax-true)
			 (not (minusp (vlax-safearray-get-u-bound
					(vlax-variant-value
					  (vla-getattributes obj)
					)
					1
				      )
			      )
			 )
		    )
		  (list	"ATT"
			(mapcar	'(lambda (att)
				   (list (vla-get-tagstring att)
					 (vla-get-textstring att)
				   )
				 )
				(k_get_atts obj)
			)
		  )
		)
		(if
		  (and (vlax-property-available-p
			 obj
			 "isdynamicblock"
		       )
		       (= (vla-get-isdynamicblock obj) :vlax-true)
		       (VLAX-METHOD-APPLICABLE-P
			 obj
			 'getdynamicblockproperties
		       )
		  )
		   (list
		     "DYN"
		     (vl-remove
		       'nil
		       (mapcar
			 '(lambda (prop)
			    (if	(= (vla-get-show prop) :vlax-true)
			      (list
				(vla-get-propertyname prop)
				(vlax-variant-value (vla-get-value prop))
			      )
			    )
			  )
			 (vlax-invoke
			   obj
			   'getdynamicblockproperties
			 )
		       )
		     )
		   )
		)
	      )
	    )
	  )
	 obj_list
       )
    )
    (cons dateiname dat)
  )

  (setq data_list (vl-bb-ref "k_sym2schema"))
  (setq dbx_temp (vl-bb-ref "k_dbx_temp"))
  (if (or (not data_list)
	  (and data_list (not (k_ja_nein "Datenliste verwenden ?")))
      )
    (progn
      (if (setq	files_list
		 (k_pfadwahl_zusammenbauen
		   (k_pfadwahl
		     (getvar "dwgprefix")
		     "Dateien wählen"
		     "*.dwg"
		     t
		     t
		   )
		 )
	  )
	(progn
	  (setq show_list files_list)
	  (k_counter_liste
	    "start"
	    "Dateien"
	    "Datei zur Erfassung öffnen"
	    nil
	  )
					;temporäre Datei als Zwischenparkplatz zur Datensammlung
	  (vl-catch-all-apply
	    'vlax-release-object
	    (list dbx_temp)
	  )
	  (k_pause 10)
	  (setq dbx_temp (k_odbx_construct))
	  (setq temp_lay_tbl (vla-get-layers dbx_temp))
	  (setq temp_blk_tbl (vla-get-blocks dbx_temp))
;;; Interface zur Bearbeitung der Dateien
	  (setq dbx_interface (k_get_interface_object))
	  (setq	data_list
		 (mapcar
		   '(lambda
		      (dateiname / temp_data_list n dummy_list tabelle zeilen)
					;                     (k_pause 500)
		       (k_counter_liste
			 "show"
			 "Datei zur Erfassung öffnen"
			 ""
			 show_list
		       )
		       (vla-open dbx_interface dateiname)
					;                     (k_pause 500)
		       (setq layer_list
			      (vl-remove-if
				'k_isxref
				(k_collection->list
				  (vla-get-layers dbx_interface)
				)
			      )
		       )
		       (setq layer_list
			      (mapcar
				'list
				(setq layernamen_list
				       (mapcar 'vla-get-name
					       layer_list
				       )
				)
				(mapcar 'vla-get-Description layer_list)
			      )
		       )
		       (setq gesamt_layer_list
			      (append gesamt_layer_list
				      layer_list
			      )
		       )
;;; Blockimport vorbereiten
		       (setq
			 obj_list (k_collection->list
				    (vla-get-modelspace dbx_interface)
				  )
		       )
		       (setq obj_list
			      (vl-remove-if-not
				'(lambda (obj_name)
				   (and
				     (member (vla-get-objectname obj_name)
					     '("AcDbBlockReference")
				     )
				     (member (vla-get-layer obj_name)
					     layernamen_list
				     )
				     (not
				       (k_isxref
					 (k_get-def obj_name dbx_interface)
				       )
				     )
				   )
				 )
				obj_list
			      )
		       )
;;; Import Blöcke
		       (setq blk_def_list
			      (k_purge_list
				(mapcar
				  '(lambda (obj)
				     (vla-Item
				       (vla-get-blocks dbx_interface)
				       (vla-get-EffectiveName obj)
				     )
				   )
				  obj_list
				)
			      )
		       )
		       (vl-catch-all-error-p
			 (vl-catch-all-apply
			   'vlax-invoke
			   (list dbx_interface
				 'CopyObjects
				 blk_def_list
				 temp_blk_tbl
			   )
			 )
		       )
;;; Import Layer
		       (vl-catch-all-error-p
			 (vl-catch-all-apply
			   'vlax-invoke
			   (list
			     dbx_interface
			     'CopyObjects
			     (mapcar
			       '(lambda	(name)
				  (vla-item (vla-get-layers
					      dbx_interface
					    )
					    name
				  )
				)
			       (k_purge_list (mapcar 'vla-get-layer obj_list))
			     )
			     temp_lay_tbl
			   )
			 )
		       )
		       (setq show_list (cdr show_list))
;;; Daten erfassen und zurückgeben
		       (setq obj_list (vl-remove-if-not
					'(lambda (obj)
					   (if (k_->ent_name obj)
					     t
					     nil
					   )
					 )
					obj_list
				      )
		       )
		       (k_sym2schema_get-data)
		    )
		   files_list
		 )
	  )
	  (vlax-release-object dbx_interface)
	  (k_counter_liste "end" "" nil nil)
	)
      )
      (vl-bb-set "k_sym2schema" data_list)
    )
  )

  (if data_list
    (progn
;;; Dialog für Sortierung der Dateien, Auswahl Layer, Abstände
      (setq n (length (apply 'append (mapcar 'cdr data_list))))
      (if (setq sort_list (k_auswahl_liste_sort (mapcar 'car data_list)))
	(progn
	  (if (setq lay_list
		     (k_auswahl_liste
		       (k_purge_list
			 (apply
			   'append
			   (mapcar
			     '(lambda (data)
				(mapcar
				  '(lambda (dat) (cadr (assoc "Layer" dat)))
				  (cdr data)
				)
			      )
			     data_list
			   )
			 )
		       )
		       "m"
		       "Liste"
		       "Layer Wählen"
		       nil
		       nil
		     )
	      )
	    (progn
	      (print)
	      (setq o_abstand (getreal "Objektabstand : "))
	      (setq z_abstand (getreal "Zeilenabstand : "))
	      (setq px '(0 0))
	      (k_counter_dialog
		"start"
		"Objekte einzeichnen"
		""
	      )
	      (foreach zeile sort_list
		(setq data_zeile (cdr (assoc zeile data_list)))
		(setq pzx px)
		(foreach ins (vl-remove-if-not
			       '(lambda	(dat)
				  (member (cadr (assoc "Layer" dat))
					  lay_list
				  )
				)
			       data_zeile
			     )
;;; Layer Import
		  (k_counter_dialog
		    "show"
		    "Layer anlegen"
		    (setq n (1- n))
		  )
		  (vl-catch-all-error-p
		    (vl-catch-all-apply
		      'vlax-invoke
		      (list dbx_temp
			    'CopyObjects
			    (mapcar '(lambda (name)
				       (vla-item (vla-get-layers
						   dbx_temp
						 )
						 name
				       )
				     )
				    (list (cadr (assoc "Layer" ins)))
			    )
			    (vla-get-layers (k_ac-doc))
		      )
		    )
		  )
;;; Block Import
		  (k_counter_dialog
		    "show"
		    "Blöcke importieren"
		    n
		  )
		  (vl-catch-all-error-p
		    (vl-catch-all-apply
		      'vlax-invoke
		      (list dbx_temp
			    'CopyObjects
			    (mapcar '(lambda (name)
				       (vla-item (vla-get-blocks
						   dbx_temp
						 )
						 name
				       )
				     )
				    (list (cadr (assoc "Blockname" ins)))
			    )
			    (vla-get-blocks (k_ac-doc))
		      )
		    )
		  )
;;; Einfügen
		  (k_counter_dialog
		    "show"
		    "Zeichnen"
		    n
		  )
		  (setq	temp_ins (vla-insertblock
				   (vla-get-block (k_ac-bereich))
				   (VLAX-3D-POINT pzx)
				   (cadr (assoc "Blockname" ins))
				   1
				   1
				   1
				   0
				 )
		  )
;;; Daten zuweisen
		  (k_counter_dialog
		    "show"
		    "Daten zuweisen (Layer, Skalierung)"
		    n
		  )
		  (vla-put-Layer temp_ins (cadr (assoc "Layer" ins)))
		  (vla-put-xscalefactor
		    temp_ins
		    (nth 0 (cadr (assoc "Blockskalierung" ins)))
		  )
		  (vla-put-yscalefactor
		    temp_ins
		    (nth 1 (cadr (assoc "Blockskalierung" ins)))
		  )
		  (vla-put-zscalefactor
		    temp_ins
		    (nth 2 (cadr (assoc "Blockskalierung" ins)))
		  )
		  (k_counter_dialog
		    "show"
		    "Daten zuweisen (Attribute, Parameterdaten)"
		    n
		  )
		  (if (assoc "ATT" ins)
		    (foreach att (cadr (assoc "ATT" ins))
		      (k_put_data temp_ins (car att) (cadr att) nil)
		    )
		  )
		  (if (assoc "DYN" ins)
		    (foreach att (cadr (assoc "DYN" ins))
		      (k_put_data temp_ins (car att) (cadr att) nil)
		    )
		  )
		  (setq pzx (mapcar '+ pzx (list o_abstand 0)))
		)
		(setq px (mapcar '+ px (list 0 z_abstand)))
	      )
	      (vl-bb-set "k_dbx_temp" dbx_temp)
					;	      (vlax-release-object dbx_temp)
	      (k_counter_dialog "end" nil nil)
	    )
	  )
	)
      )
    )
  )
  (princ)
)
;;; - ------------------------------------------------------------------------------ - ;
(princ
  (strcat
    "\nk_sym2schema:  Blöcke importieren und schematisch anordnen"
    "\n===========  "
    "\n(C) Andreas Kraus 2024 (info@kraus-cad.de)"
    "\nBefehlszeilenaufruf : k_sym2schema\n"
  )
)
;;; - ------------------------------------------------------------------------------ - ;
(princ)