;;; - ------------------------------------------------------------------------------ - ;
;;; -                 T O O L - K_SNAPSNAP                                           - ;
;;; - ------------------------------------------------------------------------------ - ;
;;; - Beschreibung :  Kontrollpunkte auf Fangraster bringen                          - ;
;;; - ------------------------------------------------------------------------------ - ;
;;; - Befehle      :  k_snapsnap                                                     - ;
;;; - ------------------------------------------------------------------------------ - ;
;;; - letzte Änderung am : 07.01.2025                                                - ;
;;; -              durch : Andreas Kraus                                             - ;
;;; - ------------------------------------------------------------------------------ - ;

(vl-load-com)
(DEFUN >AUNIT (W)
  (COND
    ((= (GETVAR "aunits") 0) (* (/ W PI) 180.0))
    ((= (GETVAR "aunits") 1)
     (STRCAT (ITOA (FIX (* (/ W PI) 180.0)))
	     "°"
	     (RTOS (* (REM (* (/ W PI) 180.0) 1) 60.0))
	     "'"
     )
    )
    ((= (GETVAR "aunits") 2) (* (/ W PI) 200.0))
    ((= (GETVAR "aunits") 3) W)
    ((= (GETVAR "aunits") 4)
     (COND
       ((= W 0) "E")
       ((< 0 W (* PI 0.5))
	(STRCAT	"N "
		(ITOA (- 90 (1+ (FIX (* (/ W PI) 180.0)))))
		"°"
		(IF (> (* (REM (* (/ W PI) 180.0) 1) 60.0) 0)
		  (RTOS (- 60.0 (* (REM (* (/ W PI) 180.0) 1) 60.0)))
		  "0"
		)
		"'"
		" E"
	)
       )
       ((= W (* PI 0.5)) "N")
       ((< (* PI 0.5) W PI)
	(STRCAT	"N "
		(ITOA (- 90 (FIX (* (/ W PI) 180.0))))
		"°"
		(IF (> (* (REM (* (/ W PI) 180.0) 1) 60.0) 0)
		  (RTOS (* (REM (* (/ W PI) 180.0) 1) 60.0))
		  "0"
		)
		"'"
		" W"
	)
       )
       ((= W PI) "W")
       ((< PI W (* PI 1.5))
	(STRCAT	"S "
		(ITOA (- 270 (1+ (FIX (* (/ W PI) 180.0)))))
		"°"
		(IF (> (* (REM (* (/ W PI) 180.0) 1) 60.0) 0)
		  (RTOS (- 60.0 (* (REM (* (/ W PI) 180.0) 1) 60.0)))
		  "0"
		)
		"'"
		" W"
	)
       )
       ((= W (* PI 1.5)) "S")
       ((< (* PI 1.5) W (* PI 2.5))
	(STRCAT	"S "
		(ITOA (ABS (- 270 (FIX (* (/ W PI) 180.0)))))
		"°"
		(IF (> (* (REM (* (/ W PI) 180.0) 1) 60.0) 0)
		  (RTOS (* (REM (* (/ W PI) 180.0) 1) 60.0))
		  "0"
		)
		"'"
		" E"
	)
       )
     )
    )
  )
)
(DEFUN DEG (Z) (* (/ Z PI) 180.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_->OBJ_NAME (NAME)
  (COND	((= (TYPE NAME) (QUOTE ENAME))
	 (vlax-ename->vla-object NAME)
	)
	((= (TYPE NAME) (QUOTE VLA-OBJECT)) NAME)
	((= (TYPE NAME) (QUOTE STR))
	 (vlax-ename->vla-object (HANDENT NAME))
	)
	((AND (= (TYPE NAME) (QUOTE LIST)) (ASSOC -1 NAME))
	 (vlax-ename->vla-object (CDR (ASSOC -1 NAME)))
	)
	((AND (= (TYPE NAME) (QUOTE LIST)) (ASSOC 5 NAME))
	 (vlax-ename->vla-object (HANDENT (CDR (ASSOC 5 NAME))))
	)
  )
)
(DEFUN K_AC-DOC	nil
  (vla-get-ActiveDocument (vlax-get-acad-object))
)
(DEFUN K_ACBC (DUMMY1 DUMMY2)
  (IF (AND (VL-STRING-SEARCH "BricsCAD" (GETVAR "acadver")))
    DUMMY2
    DUMMY1
  )
)
(DEFUN K_CALC_SNAP (P SNAP / P1 P2 TEIL)
  (IF (NOT (EQUAL (REM P SNAP) 0.0))
    (PROGN (SETQ TEIL (FIX (/ P SNAP)))
	   (SETQ P1 (* TEIL SNAP))
	   (IF (MINUSP P)
	     (SETQ P2 (* (1- TEIL) SNAP))
	     (SETQ P2 (* (1+ TEIL) SNAP))
	   )
	   (COND ((< (ABS (- P P1)) (ABS (- P P2))) (SETQ P P1))
		 ((> (ABS (- P P1)) (ABS (- P P2))) (SETQ P P2))
		 ((= (ABS (- P P1)) (ABS (- P P2))) (SETQ P P2))
	   )
    )
  )
  P
)
(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_DATE (/ D)
  (SETQ	D (ITOA (FIX (GETVAR "cdate")))
	D (STRCAT (SUBSTR D 1 4)
		  "-"
		  (SUBSTR D 5 2)
		  "-"
		  (SUBSTR D 7 2)
	  )
  )
)
(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_GET-INI-DIR (SUCHPFAD / INI_DIR ORDNER SUCHPFAD)
  (IF (VL-FILE-DIRECTORY-P (GETVAR "dwgprefix"))
    (PROGN (IF (NOT 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_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"
  )
  (IF (AND (NULL DATEIPFAD)
	   (SETQ INI_LIST (K_GET_MERKLISTE "k_ini"))
      )
    (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
	   )
    )
  )
  (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_MERKLISTE (NAME / WERT)
  (IF (ASSOC NAME K_MERKLISTE)
    (SETQ WERT (NTH 1 (ASSOC NAME K_MERKLISTE)))
  )
  WERT
)
(DEFUN K_GET_USERPATH (START_SUCHPFAD NAME / PFAD_LIST SUCHPFAD)
  (FINDFILE (STRCAT (K_GET-INI-DIR START_SUCHPFAD) NAME))
)
(DEFUN K_INI_UPDATE (/ 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 (NOT (= (K_GET_MERKLISTE "k_ini_update") "stop"))
    (PROGN
      (IF
	(OR (NOT (K_GET_USERPATH DATEIPFAD "k_projekt.ini"))
	    (AND (> (SETQ Z (VL-PRINC-TO-STRING
			      (VL-FILE-SYSTIME
				(FINDFILE
				  (K_GET_USERPATH DATEIPFAD "k_projekt.ini")
				)
			      )
			    )
		    )
		    (IF	(K_GET_MERKLISTE "k_ini_updatetime")
		      (VL-PRINC-TO-STRING
			(K_GET_MERKLISTE "k_ini_updatetime")
		      )
		      ""
		    )
		 )
		 (SETQ PROJEKT_PFAD
			(K_GET_USERPATH DATEIPFAD "k_projekt.ini")
		 )
	    )
	)
	 (PROGN
	   (IF (GETVAR "SECURELOAD")
	     (PROGN (K_SAVE_VAR "SECURELOAD") (SETVAR "SECURELOAD" 0))
	   )
	   (IF (NULL PROJEKT_PFAD)
	     (PROGN
	       (SETQ PROJEKT_PFAD
		      (STRCAT (K_NEU_USERPATH DATEIPFAD)
			      "k_projekt.ini"
		      )
	       )
	       (IF (SETQ GLOBAL_PFAD (FINDFILE "k_global.ini"))
		 (SETQ INI_LIST (K_LOAD GLOBAL_PFAD))
		 (IF (SETQ MAIN_PFAD (FINDFILE "k_main.ini"))
		   (PROGN
		     (SETQ INI_LIST (K_LOAD MAIN_PFAD))
		     (K_PRINT_DATEI
		       (STRCAT (K_PATHSLASH
				 (VL-FILENAME-DIRECTORY MAIN_PFAD)
				 nil
			       )
			       "k_main.ini"
		       )
		       (VL-REMOVE-IF
			 (QUOTE (LAMBDA (EINTRAG) (NULL (CADR EINTRAG))))
			 INI_LIST
		       )
		     )
		   )
		 )
	       )
	       (K_PRINT_DATEI
		 PROJEKT_PFAD
		 (VL-REMOVE-IF
		   (QUOTE (LAMBDA (EINTRAG) (NULL (CADR EINTRAG))))
		   INI_LIST
		 )
	       )
	     )
	   )
	   (IF (SETQ MAIN_PFAD (FINDFILE "k_main.ini"))
	     (IF (SETQ GLOBAL_PFAD (FINDFILE "k_global.ini"))
	       (PROGN (IF (> (K_TIMESTRING MAIN_PFAD)
			     (K_TIMESTRING GLOBAL_PFAD)
			  )
			(K_CHECK_NEU_INI MAIN_PFAD GLOBAL_PFAD)
		      )
		      (IF (> (K_TIMESTRING GLOBAL_PFAD)
			     (K_TIMESTRING PROJEKT_PFAD)
			  )
			(K_CHECK_NEU_INI GLOBAL_PFAD PROJEKT_PFAD)
		      )
	       )
	     )
	   )
	   (IF (GETVAR "SECURELOAD")
	     (K_RESTORE_VAR "SECURELOAD")
	   )
	 )
      )
      (SETQ PROJEKT_PFAD (K_GET_USERPATH DATEIPFAD "k_projekt.ini"))
      (SETQ INI_LIST (K_LOAD PROJEKT_PFAD))
      (K_PUT_MERKLISTE "k_ini" INI_LIST)
      (K_PUT_MERKLISTE "k_ini_updatetime" Z)
    )
  )
)
(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_LISTE->VARIANT	(LISTE TYP)
  (vlax-make-variant
    (vlax-safearray-fill
      (vlax-make-safearray 5 (CONS 0 (1- (LENGTH LISTE))))
      LISTE
    )
    TYP
  )
)
(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_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_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_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_PUT_MERKLISTE (NAME WERT)
  (IF (ASSOC NAME K_MERKLISTE)
    (SETQ K_MERKLISTE
	   (SUBST (LIST NAME WERT)
		  (ASSOC NAME K_MERKLISTE)
		  K_MERKLISTE
	   )
    )
    (SETQ K_MERKLISTE (CONS (LIST NAME WERT) K_MERKLISTE))
  )
  (PRINC)
)
(DEFUN K_RESTORE_VAR (VARLIST / K_SAVEVAR_LIST)
  (SETQ K_SAVEVAR_LIST (K_GET_MERKLISTE "k_savevar_list"))
  (IF (= VARLIST "*")
    (SETQ VARLIST
	   (MAPCAR (QUOTE (LAMBDA (VAR) (NTH 0 VAR))) K_SAVEVAR_LIST)
    )
  )
  (IF (= (TYPE VARLIST) (QUOTE STR))
    (SETQ VARLIST (LIST VARLIST))
  )
  (FOREACH VAR VARLIST
    (IF	(SETQ VAR (ASSOC VAR K_SAVEVAR_LIST))
      (SETVAR (NTH 0 VAR) (NTH 1 VAR))
    )
  )
)
(DEFUN K_SATZ->ENTLIST (SATZ)
  (IF (= (TYPE SATZ) (QUOTE PICKSET))
    (VL-REMOVE-IF-NOT
      (QUOTE (LAMBDA (DUMMY) (= (TYPE DUMMY) (QUOTE ENAME))))
      (MAPCAR (QUOTE CADR) (SSNAMEX SATZ))
    )
  )
)
(DEFUN K_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_SET_INI (EINTRAG WERT DATEIPFAD / PFAD INI_LIST)
  (IF (GETVAR "SECURELOAD")
    (PROGN (K_SAVE_VAR "SECURELOAD") (SETVAR "SECURELOAD" 0))
  )
  (K_INI_UPDATE)
  (IF (NULL DATEIPFAD)
    (SETQ DATEIPFAD "")
  )
  (IF (FINDFILE DATEIPFAD)
    (SETQ INI_LIST (K_LOAD (SETQ PFAD DATEIPFAD)))
    (IF	(SETQ PFAD (K_GET_USERPATH DATEIPFAD "k_projekt.ini"))
      (SETQ INI_LIST (K_LOAD PFAD))
      (IF (SETQ PFAD (FINDFILE "k_global.ini"))
	(PROGN
	  (SETQ INI_LIST (K_LOAD PFAD))
	  (SETQ PFAD (STRCAT (K_NEU_USERPATH nil) "k_projekt.ini"))
	)
	(PROGN (SETQ PFAD (STRCAT (K_NEU_USERPATH (GETVAR "dwgprefix"))
				  "k_projekt.ini"
			  )
	       )
	)
      )
    )
  )

  (IF
    (ASSOC EINTRAG
	   (MAPCAR (QUOTE (LAMBDA (DATA)
			    (IF	(= (TYPE (CAR DATA)) (QUOTE LIST))
			      (CONS (CAAR DATA) (CDR DATA))
			      DATA
			    )
			  )
		   )
		   INI_LIST
	   )
    )
     (SETQ INI_LIST
	    (SUBST_POS
	      INI_LIST
	      (LIST (LIST EINTRAG (STRCAT (K_DATE) ", " (K_TIME)))
		    WERT
	      )
	      (VL-POSITION
		(ASSOC
		  EINTRAG
		  (MAPCAR
		    (QUOTE
		      (LAMBDA (DATA)
			(IF (= (TYPE (CAR DATA)) (QUOTE LIST))
			  (CONS (CAAR DATA) (CDR DATA))
			  DATA
			)
		      )
		    )
		    INI_LIST
		  )
		)
		(MAPCAR
		  (QUOTE (LAMBDA (DATA)
			   (IF (= (TYPE (CAR DATA)) (QUOTE LIST))
			     (CONS (CAAR DATA) (CDR DATA))
			     DATA
			   )
			 )
		  )
		  INI_LIST
		)
	      )
	    )
     )
     (SETQ INI_LIST
	    (REVERSE (CONS (LIST EINTRAG WERT) (REVERSE INI_LIST))
	    )
     )
  )
  (K_PRINT_DATEI
    PFAD
    (VL-REMOVE-IF
      (QUOTE (LAMBDA (EINTRAG) (NULL (CADR EINTRAG))))
      INI_LIST
    )
  )
  (K_PUT_MERKLISTE "k_ini" nil)
  (vlax-ldata-put
    (vla-Item (vla-get-Layers (K_AC-DOC)) "0")
    "k_ini"
    INI_LIST
  )

  (IF (GETVAR "SECURELOAD")
    (K_RESTORE_VAR "SECURELOAD")
  )
  (PRINC)
)
(DEFUN K_STELLENZAHL (TXT STELLEN)
  (WHILE (< (STRLEN TXT) STELLEN) (SETQ TXT (STRCAT "0" TXT)))
  TXT
)
(DEFUN K_TIME (/ Z)
  (SETQ Z (GETVAR "cdate"))
  (SETQ Z (- Z (FIX Z)))
  (SETQ	Z (VL-STRING-LEFT-TRIM
	    "."
	    (VL-STRING-LEFT-TRIM "0" (RTOS Z 2 7))
	  )
  )
  (WHILE (< (STRLEN Z) 6) (SETQ Z (STRCAT Z "0")))
  (SETQ	Z (STRCAT (SUBSTR Z 1 2)
		  ":"
		  (SUBSTR Z 3 2)
		  ":"
		  (SUBSTR Z 5 2)
	  )
  )
)
(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_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_W-KONVERT (W MODUS-START MODUS-ZIEL)
  (IF (/= MODUS-START MODUS-ZIEL)
    (COND ((AND (= MODUS-START 0) (= MODUS-ZIEL 3)) (RAD W))
	  ((AND (= MODUS-START 3) (= MODUS-ZIEL 0)) (DEG W))
    )
    W
  )
)
(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 RAD (Z) (* (/ Z 180.0) PI))
(DEFUN SUBST_POS (LISTE WERT POS / PART1 PART2)
  (SETQ PART1 (REVERSE LISTE))
  (WHILE (> (LENGTH PART1) POS) (SETQ PART1 (CDR PART1)))
  (SETQ PART2 LISTE)
  (REPEAT (1+ POS) (SETQ PART2 (CDR PART2)))
  (APPEND (REVERSE PART1) (LIST WERT) PART2)
)



(defun c:k_snapsnap (/		AKTION	   ATYPE      C
		     DUMMY_LIST	ENT_DATA   GRIP_AUSWAHL_LISTE
		     GRIP_DATA	GRIP_LISTE GRIP_POS   M
		     MEM_AUNIT	N	   OBJ_NAME   OK
		     P		P1	   P2	      P3
		     P_LIST	P_VARIANT  R	      SATZ
		     SNAP_ANG	SNAP_BASE  SNAP_DATA  SNAP_LISTE
		     SNAP_X	SNAP_Y	   SNAP_Z     VALUE
		     VTYPE	W1	   W2	      k_snapsnap_ID
		    )
;;; Objekte auf Raster schieben

  (defun k_snapsnap_end	(wert)
    (setq ok wert)
    (done_dialog wert)
  )

  (defun k_snapsnap_zeige_grip_liste ()
    (setq grip_liste
	   (vl-sort grip_liste
		    '(lambda (q1 q2)
		       (< (vl-princ-to-string q1)
			  (vl-princ-to-string q2)
		       )
		     )
	   )
    )
    (start_list "grip_liste")
    (mapcar 'add_list (mapcar 'vl-princ-to-string grip_liste))
    (end_list)
  )

  (defun k_snapsnap_zeige_grip_auswahl_liste ()
    (setq grip_auswahl_liste
	   (vl-sort grip_auswahl_liste
		    '(lambda (q1 q2)
		       (< (vl-princ-to-string q1)
			  (vl-princ-to-string q2)
		       )
		     )
	   )
    )
    (start_list "grip_auswahl")
    (mapcar 'add_list
	    (mapcar 'vl-princ-to-string grip_auswahl_liste)
    )
    (end_list)
  )

  (defun k_snapsnap_zeige_snap_liste ()
    (start_list "snap_liste")
    (mapcar 'add_list (mapcar 'vl-princ-to-string snap_liste))
    (end_list)
  )

  (defun k_snapsnap_snap_liste ()
    (setq snap_data (nth (atoi (get_tile "snap_liste")) snap_liste))
    (set_tile "snap_name" (nth 0 snap_data))
    (set_tile "x" (vl-princ-to-string (nth 1 snap_data)))
    (set_tile "y" (vl-princ-to-string (nth 2 snap_data)))
    (set_tile "base" (vl-princ-to-string (nth 3 snap_data)))
    (set_tile "angle" (vl-princ-to-string (nth 4 snap_data)))
    (set_tile "vonblock" (vl-princ-to-string (nth 5 snap_data)))
  )

  (defun k_snapsnap_grip_liste ()
    (if	(= $reason 4)
      (progn
	(setq grip_auswahl_liste
	       (cons (setq
		       grip_data (nth (atoi (setq grip_pos
						   (get_tile
						     "grip_liste"
						   )
					    )
				      )
				      grip_liste
				 )
		     )
		     grip_auswahl_liste
	       )
	)
	(setq grip_liste (vl-remove grip_data grip_liste))

	(k_snapsnap_zeige_grip_auswahl_liste)
	(k_snapsnap_zeige_grip_liste)
      )
      (progn
	(setq snap_data (nth (atoi (get_tile "snap_liste")) snap_liste))
	(setq
	  grip_data
	   (nth	(atoi (setq grip_pos (get_tile "grip_liste")))
		grip_liste
	   )
	)
	(setq grip_data (list (nth 0 grip_data) (nth 0 snap_data)))
	(setq grip_liste
	       (subst grip_data
		      (assoc (nth 0 grip_data) grip_liste)
		      grip_liste
	       )
	)
	(k_snapsnap_zeige_grip_liste)
	(set_tile "grip_liste" grip_pos)
      )
    )
  )

  (defun k_snapsnap_grip_auswahl ()
    (if	(= $reason 4)
      (progn
	(setq grip_liste
	       (cons (setq
		       grip_data
			(nth (atoi (setq grip_pos (get_tile
						    "grip_auswahl"
						  )
				   )
			     )
			     grip_auswahl_liste
			)
		     )
		     grip_liste
	       )
	)
	(setq grip_auswahl_liste
	       (vl-remove grip_data grip_auswahl_liste)
	)
	(k_snapsnap_zeige_grip_auswahl_liste)
	(k_snapsnap_zeige_grip_liste)
      )
    )
  )

  (defun k_snapsnap_ucs	(art)
    (if	(setq snap_data (assoc (cadr (assoc art grip_liste)) snap_liste))
      (progn
	(command "_ucs" "_w")
	(command "_ucs" "_m" (nth 3 snap_data))
	(if (and (= art "Blockbasispunkt") (= (nth 5 snap_data) 1))
	  (command
	    "_ucs"
	    "z"
	    (k_w-konvert (cdr (assoc 50 ent_data)) 3 (getvar "aunits"))
	  )
	  (if (k_is (nth 5 snap_data))
	    (command "_ucs" "z" (>aunit (cdr (assoc 50 ent_data))))
	    (command "_ucs" "z" (nth 4 snap_data))
	  )
	)
	(setvar "snapbase" '(0.0 0.0))
	(setvar "snapang" 0)
	(setq snap_x (nth 1 snap_data))
	(setq snap_y (nth 2 snap_data))
	t
      )
    )
  )

  (defun k_snapsnap_in_liste ()
    (if	(assoc (get_tile "snap_name") snap_liste)
      (setq snap_liste
	     (subst (list (get_tile "snap_name")
			  (atof (get_tile "x"))
			  (atof (get_tile "y"))
			  (read (get_tile "base"))
			  (atof (get_tile "angle"))
			  (atoi (get_tile "vonblock"))
		    )
		    (assoc (get_tile "snap_name") snap_liste)
		    snap_liste
	     )
      )
      (setq snap_liste
	     (append snap_liste
		     (list (list (get_tile "snap_name")
				 (atof (get_tile "x"))
				 (atof (get_tile "y"))
				 (read (get_tile "base"))
				 (atof (get_tile "angle"))
				 (atoi (get_tile "vonblock"))
			   )
		     )
	     )
      )
    )
    (k_snapsnap_zeige_snap_liste)
  )

  (setvar "cmdecho" 0)
  (setq satz (nth 1 (ssgetfirst)))
  (vla-startundomark (k_ac-doc))
  (k_save_var '("aunits" "snapbase" "snapang" "snapunit"))
  (setvar "aunits" 3)
  (setq snap_x (nth 0 (getvar "snapunit")))
  (setq snap_y (nth 1 (getvar "snapunit")))
  (setq snap_base (getvar "snapbase"))
  (setq snap_ang (getvar "snapang"))
  (setq grip_auswahl_liste nil)

  (setq
    snap_liste
     (append
       (list (list "-aktuell" snap_x snap_y snap_base snap_ang 0))
       (k_get_ini "Fangeinstellungen" nil)
     )
  )

  (setq	grip_liste
	 '(
	   ("Punkt" "-aktuell")
	   ("Linienendpunkt" "-aktuell")
	   ("Blockbasispunkt" "-aktuell")
	   ("Polylinienstützpunkt" "-aktuell")
	   ("Splinekontrollpunkt" "-aktuell")
	   ("Kreiszentrum" "-aktuell")
	   ("Kreisradius" "-aktuell")
	   ("Ellipsenzentrum" "-aktuell")
	   ("Ellipse Hauptachse" "-aktuell")
	   ("Ellipse Nebenachse" "-aktuell")
	   ("Multilinienstützpunkt" "-aktuell")
	   ("Texteinfügepunkt" "-aktuell")
	   ("Texthöhe" "-aktuell")
	   ("MTEXT-Einfügepunkt" "-aktuell")
	   ("MTEXT-Höhe" "-aktuell")
	   ("Bogenendpunkte" "-aktuell")
	   ("Solidstützpunkte" "-aktuell")
	   ("Führungspunkte" "-aktuell")
	   ("Tabellenlinien" "-aktuell")
	   ("Ansichtsfensterpunkte" "-aktuell")
	  )
  )

  (setq	grip_auswahl_liste
	 '(
	   ("Bogenzentrum" "-aktuell")
	   ("Bogenradius" "-aktuell")

	  )
  )

  (setq k_snapsnap_id (load_dialog "k_snapsnap.dcl"))

  (while (or (null aktion) (> aktion 1))
    (if	(not (new_dialog "k_snapsnap" k_snapsnap_id))
      (exit)
    )
    (action_tile "in_liste" "(k_snapsnap_in_liste)")
    (action_tile "snap_liste" "(k_snapsnap_snap_liste)")
    (action_tile "grip_auswahl" "(k_snapsnap_grip_auswahl)")
    (action_tile "grip_liste" "(k_snapsnap_grip_liste)")
    (action_tile "basepic" "(k_snapsnap_end '2)")
    (action_tile "anglepic" "(k_snapsnap_end '3)")
    (action_tile "accept" "(k_snapsnap_end '1)")
    (action_tile "cancel" "(k_snapsnap_end '0)")
    (k_snapsnap_zeige_grip_liste)
    (k_snapsnap_zeige_grip_auswahl_liste)
    (k_snapsnap_zeige_snap_liste)

    (if	(and snap_data (vl-position snap_data snap_liste))
      (progn
	(set_tile "snap_liste"
		  (itoa (vl-position snap_data snap_liste))
	)
	(k_snapsnap_snap_liste)
	(if p
	  (set_tile "base" (vl-princ-to-string p))
	)
	(if w
	  (set_tile "angle" (vl-princ-to-string (k_w-konvert w 3 0)))
	)
      )

    )
    (setq aktion (start_dialog))
    (cond
      ((= aktion 2)
       (setq p (getpoint "Ursprungpunkt wählen : "))
      )
      ((= aktion 3)
       (setq w (getangle "Drehwinkel angeben : "))
      )
    )

  )

  (unload_dialog k_snapsnap_id)
  (if (= ok 1)
    (progn
      (k_set_ini "Fangeinstellungen" (cdr snap_liste) nil)
      (if (tblsearch "UCS" "entsnap")
	(command "_ucs" "l" "entsnap")
      )
      (command "_ucs" "sp" "entsnap")
      (if (null satz)
	(setq satz (ssget))
      )
      (if satz
	(progn
	  (setq n (1- (sslength satz)))
	  (foreach ent_name (k_satz->entlist satz)
	    (princ (strcat "\r" (itoa n) "  "))
	    (setq ent_data (entget ent_name))
	    (setq obj_name (k_->obj_name ent_name))
	    (cond
	      ((= (cdr (assoc 0 ent_data)) "POINT")
	       (if (k_snapsnap_ucs "Punkt")
		 (progn
		   (setq p (trans (cdr (assoc 10 ent_data)) 0 1))
		   (setq p (trans (list	(k_calc_snap (nth 0 p) snap_x)
					(k_calc_snap (nth 1 p) snap_y)
				  )
				  1
				  0
			   )
		   )
		   (setq
		     ent_data (subst (cons 10 p)
				     (assoc 10 ent_data)
				     ent_data
			      )
		   )
		 )
	       )
	      )

	      ((= (cdr (assoc 0 ent_data)) "LINE")
	       (if (k_snapsnap_ucs "Linienendpunkt")
		 (progn
		   (setq p (trans (cdr (assoc 10 ent_data)) 0 1))
		   (setq p (trans (list	(k_calc_snap (nth 0 p) snap_x)
					(k_calc_snap (nth 1 p) snap_y)
				  )
				  1
				  0
			   )
		   )
		   (setq
		     ent_data (subst (cons 10 p)
				     (assoc 10 ent_data)
				     ent_data
			      )
		   )
		   (setq p (trans (cdr (assoc 11 ent_data)) 0 1))
		   (setq p (trans (list	(k_calc_snap (nth 0 p) snap_x)
					(k_calc_snap (nth 1 p) snap_y)
				  )
				  1
				  0
			   )
		   )
		   (setq
		     ent_data (subst (cons 11 p)
				     (assoc 11 ent_data)
				     ent_data
			      )
		   )
		 )
	       )
	      )

	      ((= (cdr (assoc 0 ent_data)) "INSERT")
	       (if (k_snapsnap_ucs "Blockbasispunkt")
		 (progn
		   (setq p1 (trans (cdr (assoc 10 ent_data)) 0 1))
		   (setq
		     p (trans (list (k_calc_snap (nth 0 p1) snap_x)
				    (k_calc_snap (nth 1 p1) snap_y)
			      )
			      1
			      0
		       )
		   )
		   (setq
		     ent_data
		      (subst (cons 10 p) (assoc 10 ent_data) ent_data)
		   )
		   (command "_move" ent_name "" p1 (trans p 0 1))
		 )
	       )
	      )

	      ((= (cdr (assoc 0 ent_data)) "POLYLINE")
	       (if (k_snapsnap_ucs "Polylinienstützpunkt")
		 (progn
		   (setq snap_z snap_x)
		   (setq obj_name  (vlax-ename->vla-object ent_name)
			 p_variant (vla-get-coordinates obj_name)
			 vtype	   (vlax-variant-type p_variant)
			 value	   (vlax-variant-value p_variant)
			 atype	   (vlax-safearray-type value)
			 p_list	   (apply
				     'append
				     (mapcar
				       '(lambda	(p)
					  (setq p (trans p 0 1))
					  (setq	p
						 (trans
						   (list
						     (k_calc_snap (nth 0 p) snap_x)
						     (k_calc_snap (nth 1 p) snap_y)
						     (k_calc_snap (nth 2 p) snap_z)
						   )
						   1
						   0
						 )
					  )
					)
				       (gather (vlax-safearray->list value) 3)
				     )
				   )
		   )
		   (vla-put-coordinates
		     obj_name
		     (vlax-make-variant
		       (vlax-safearray-fill
			 (vlax-make-safearray
			   atype
			   (cons (vlax-safearray-get-l-bound value 1)
				 (vlax-safearray-get-u-bound value 1)
			   )
			 )
			 p_list
		       )
		       vtype
		     )
		   )
		 )
	       )
	      )

	      ((= (cdr (assoc 0 ent_data)) "LWPOLYLINE")
	       (if (k_snapsnap_ucs "Polylinienstützpunkt")
		 (progn
		   (setq dummy_list (list))
		   (foreach p ent_data
		     (if (= (car p) 10)
		       (progn
			 (setq p (trans (cdr p) 0 1))
			 (setq p
				(cons
				  10
				  (trans (list (k_calc_snap (nth 0 p) snap_x)
					       (k_calc_snap (nth 1 p) snap_y)
					 )
					 1
					 0
				  )
				)
			 )
		       )
		     )
		     (setq dummy_list (cons p dummy_list))
		   )
		   (setq ent_data (reverse dummy_list))
		   (entmod ent_data)
		 )
	       )
	      )


	      ((= (cdr (assoc 0 ent_data)) "SPLINE")
	       (if (k_snapsnap_ucs "Splinekontrollpunkt")
		 (progn
		   (if
		     (not (setq
			    p_list (gather (k_variant->value
					     (vla-get-FitPoints obj_name)
					   )
					   3
				   )
			  )
		     )
		      (setq p_list
			     (gather (k_variant->value
				       (vla-get-ControlPoints obj_name)
				     )
				     3
			     )
		      )
		   )
		   (setq p_list
			  (mapcar
			    '(lambda (p)
			       (setq p (trans p 0 1))
			       (trans
				 (list (k_calc_snap (nth 0 p) snap_x)
				       (k_calc_snap (nth 1 p) snap_y)
				       (nth 2 p)
				 )
				 1
				 0
			       )
			     )
			    p_list
			  )
		   )
		   (if (k_variant->value (vla-get-FitPoints obj_name))
		     (vla-put-FitPoints
		       obj_name
		       (k_liste->variant (apply 'append p_list) 8197)
		     )
		     (vla-put-ControlPoints
		       obj_name
		       (k_liste->variant (apply 'append p_list) 8197)
		     )
		   )
		   (setq ent_data nil)
		 )
	       )
	      )

	      ((= (cdr (assoc 0 ent_data)) "CIRCLE")
	       (if (k_snapsnap_ucs "Kreiszentrum")
		 (progn
		   (setq p (trans (cdr (assoc 10 ent_data)) 0 1))
		   (setq p (trans (list	(k_calc_snap (nth 0 p) snap_x)
					(k_calc_snap (nth 1 p) snap_y)
				  )
				  1
				  0
			   )
		   )
		   (setq
		     ent_data (subst (cons 10 p)
				     (assoc 10 ent_data)
				     ent_data
			      )
		   )
		 )
	       )
	       (if (k_snapsnap_ucs "Kreisradius")
		 (progn
		   (setq p (cdr (assoc 40 ent_data)))
		   (setq p (k_calc_snap p snap_x))
		   (setq
		     ent_data (subst (cons 40 p)
				     (assoc 40 ent_data)
				     ent_data
			      )
		   )
		 )
	       )
	      )

	      ((= (cdr (assoc 0 ent_data)) "ELLIPSE")
	       (if (k_snapsnap_ucs "Ellipsenzentrum")
		 (progn
		   (setq p (trans (cdr (assoc 10 ent_data)) 0 1))
		   (setq p (trans (list	(k_calc_snap (nth 0 p) snap_x)
					(k_calc_snap (nth 1 p) snap_y)
				  )
				  1
				  0
			   )
		   )
		   (setq
		     ent_data (subst (cons 10 p)
				     (assoc 10 ent_data)
				     ent_data
			      )
		   )
		 )
	       )
	       (if (k_snapsnap_ucs "Ellipse Hauptachse")
		 (progn
		   (setq p (vla-get-MajorRadius obj_name))
		   (setq p (k_calc_snap p snap_x))
		   (vla-put-MajorRadius obj_name p)
		 )
	       )
	       (if (k_snapsnap_ucs "Ellipse Nebenachse")
		 (progn
		   (setq p (vla-get-MinorRadius obj_name))
		   (setq p (k_calc_snap p snap_y))
		   (vla-put-MinorRadius obj_name p)
		 )
	       )
	       (setq ent_data nil)
	      )

	      ((= (cdr (assoc 0 ent_data)) "MLINE")
	       (if (k_snapsnap_ucs "Multilinienstützpunkt")
		 (progn
		   (setq dummy_list (list))
		   (foreach p ent_data
		     (if (= (car p) 10)
		       (progn
			 (setq p (trans (cdr p) 0 1))
			 (setq p
				(cons
				  10
				  (trans (list (k_calc_snap (nth 0 p) snap_x)
					       (k_calc_snap (nth 1 p) snap_y)
					 )
					 1
					 0
				  )
				)
			 )
		       )
		     )
		     (if (= (car p) 11)
		       (progn
			 (setq p (trans (cdr p) 0 1))
			 (setq p
				(cons
				  11
				  (trans (list (k_calc_snap (nth 0 p) snap_x)
					       (k_calc_snap (nth 1 p) snap_y)
					 )
					 1
					 0
				  )
				)
			 )
		       )
		     )
		     (setq dummy_list (cons p dummy_list))
		   )
		   (setq ent_data (reverse dummy_list))
		 )
	       )
	      )

	      ((= (cdr (assoc 0 ent_data)) "TEXT")
	       (if (k_snapsnap_ucs "Texteinfügepunkt")
		 (progn
		   (if (and (= (cdr (assoc 71 ent_data)) 0)
			    (= (cdr (assoc 72 ent_data)) 0)
		       )
		     (progn
		       (setq p (trans (cdr (assoc 10 ent_data)) 0 1))
		       (setq
			 p (trans (list	(k_calc_snap (nth 0 p) snap_x)
					(k_calc_snap (nth 1 p) snap_y)
				  )
				  1
				  0
			   )
		       )
		       (setq
			 ent_data (subst (cons 10 p)
					 (assoc 10 ent_data)
					 ent_data
				  )
		       )
		     )
		     (progn
		       (setq p (trans (cdr (assoc 11 ent_data)) 0 1))
		       (setq
			 p (trans (list	(k_calc_snap (nth 0 p) snap_x)
					(k_calc_snap (nth 1 p) snap_y)
				  )
				  1
				  0
			   )
		       )
		       (setq
			 ent_data (subst (cons 11 p)
					 (assoc 11 ent_data)
					 ent_data
				  )
		       )
		     )
		   )
		 )
	       )
	       (if (k_snapsnap_ucs "Texthöhe")
		 (progn
		   (setq p (cdr (assoc 40 ent_data)))
		   (setq p (k_calc_snap p snap_x))
		   (setq
		     ent_data (subst (cons 40 p)
				     (assoc 40 ent_data)
				     ent_data
			      )
		   )
		 )
	       )
	      )

	      ((= (cdr (assoc 0 ent_data)) "MTEXT")
	       (if (k_snapsnap_ucs "MTEXT-Einfügepunkt")
		 (progn
		   (setq p (trans (cdr (assoc 10 ent_data)) 0 1))
		   (setq p (trans (list	(k_calc_snap (nth 0 p) snap_x)
					(k_calc_snap (nth 1 p) snap_y)
				  )
				  1
				  0
			   )
		   )
		   (setq
		     ent_data (subst (cons 10 p)
				     (assoc 10 ent_data)
				     ent_data
			      )
		   )
		 )
	       )
	       (if (k_snapsnap_ucs "MTEXT-Höhe")
		 (progn
		   (setq p (cdr (assoc 40 ent_data)))
		   (setq p (k_calc_snap p snap_x))
		   (setq
		     ent_data (subst (cons 40 p)
				     (assoc 40 ent_data)
				     ent_data
			      )
		   )
		 )
	       )
	      )

	      ((= (cdr (assoc 0 ent_data)) "ARC")
	       (if (k_snapsnap_ucs "Bogenzentrum")
		 (progn
		   (setq p (trans (cdr (assoc 10 ent_data)) 0 1))
		   (setq p (trans (list	(k_calc_snap (nth 0 p) snap_x)
					(k_calc_snap (nth 1 p) snap_y)
				  )
				  1
				  0
			   )
		   )
		   (setq
		     ent_data (subst (cons 10 p)
				     (assoc 10 ent_data)
				     ent_data
			      )
		   )
		 )
	       )
	       (if (k_snapsnap_ucs "Bogenradius")
		 (progn
		   (setq p (cdr (assoc 40 ent_data)))
		   (setq p (k_calc_snap p snap_x))
		   (setq
		     ent_data (subst (cons 40 p)
				     (assoc 40 ent_data)
				     ent_data
			      )
		   )
		 )
	       )
	       (if (k_snapsnap_ucs "Bogenendpunkte")
		 (progn
		   (setq p1
			  (k_variant->value (vla-get-StartPoint obj_name))
		   )
		   (setq
		     p3	(k_variant->value (vla-get-EndPoint obj_name))
		   )
		   (setq
		     p2	(polar
			  (k_variant->value (vla-get-Center obj_name))
			  (+ (vla-get-StartAngle obj_name)
			     (/ (vla-get-TotalAngle obj_name) 2.0)
			  )
			  (vla-get-Radius obj_name)
			)
		   )

		   (setq p1 (trans p1 0 1))
		   (setq
		     p1	(trans (list (k_calc_snap (nth 0 p1) snap_x)
				     (k_calc_snap (nth 1 p1) snap_y)
			       )
			       1
			       0
			)
		   )
		   (setq p2 (trans p2 0 1))
		   (setq
		     p2	(trans (list (k_calc_snap (nth 0 p2) snap_x)
				     (k_calc_snap (nth 1 p2) snap_y)
			       )
			       1
			       0
			)
		   )
		   (setq p3 (trans p3 0 1))
		   (setq
		     p3	(trans (list (k_calc_snap (nth 0 p3) snap_x)
				     (k_calc_snap (nth 1 p3) snap_y)
			       )
			       1
			       0
			)
		   )
		   (polar p1 (angle p1 p2) (/ (distance p1 p2) 2.0))
		   (polar p2 (angle p2 p3) (/ (distance p2 p3) 2.0))
		   (setq
		     c (inters (polar p1
				      (angle p1 p2)
				      (/ (distance p1 p2) 2.0)
			       )
			       (polar (polar p1
					     (angle p1 p2)
					     (/ (distance p1 p2) 2.0)
				      )
				      (+ (angle p1 p2) (/ pi 2.0))
				      1
			       )
			       (polar p2
				      (angle p2 p3)
				      (/ (distance p2 p3) 2.0)
			       )
			       (polar (polar p2
					     (angle p2 p3)
					     (/ (distance p2 p3) 2.0)
				      )
				      (+ (angle p2 p3) (/ pi 2.0))
				      1
			       )
			       nil
		       )
		   )
		   (setq w1 (angle c p1))
		   (setq w2 (angle c p3))
		   (setq r (distance c p1))
		   (setq
		     ent_data (subst (cons 10 c)
				     (assoc 10 ent_data)
				     ent_data
			      )
		   )
		   (setq
		     ent_data (subst (cons 40 r)
				     (assoc 40 ent_data)
				     ent_data
			      )
		   )
		   (setq
		     ent_data (subst (cons 50 w1)
				     (assoc 50 ent_data)
				     ent_data
			      )
		   )
		   (setq
		     ent_data (subst (cons 51 w2)
				     (assoc 51 ent_data)
				     ent_data
			      )
		   )
		 )
	       )
	      )

	      ((= (cdr (assoc 0 ent_data)) "SOLID")
	       (if (k_snapsnap_ucs "Solidstützpunkte")
		 (progn
		   (setq p (trans (cdr (assoc 10 ent_data)) 0 1))
		   (setq p (trans (list	(k_calc_snap (nth 0 p) snap_x)
					(k_calc_snap (nth 1 p) snap_y)
				  )
				  1
				  0
			   )
		   )
		   (setq
		     ent_data (subst (cons 10 p)
				     (assoc 10 ent_data)
				     ent_data
			      )
		   )
		   (setq p (trans (cdr (assoc 11 ent_data)) 0 1))
		   (setq p (trans (list	(k_calc_snap (nth 0 p) snap_x)
					(k_calc_snap (nth 1 p) snap_y)
				  )
				  1
				  0
			   )
		   )
		   (setq
		     ent_data (subst (cons 11 p)
				     (assoc 11 ent_data)
				     ent_data
			      )
		   )
		   (setq p (trans (cdr (assoc 12 ent_data)) 0 1))
		   (setq p (trans (list	(k_calc_snap (nth 0 p) snap_x)
					(k_calc_snap (nth 1 p) snap_y)
				  )
				  1
				  0
			   )
		   )
		   (setq
		     ent_data (subst (cons 12 p)
				     (assoc 12 ent_data)
				     ent_data
			      )
		   )
		   (setq p (trans (cdr (assoc 13 ent_data)) 0 1))
		   (setq p (trans (list	(k_calc_snap (nth 0 p) snap_x)
					(k_calc_snap (nth 1 p) snap_y)
				  )
				  1
				  0
			   )
		   )
		   (setq
		     ent_data (subst (cons 13 p)
				     (assoc 13 ent_data)
				     ent_data
			      )
		   )
		 )
	       )
	      )

	      ((= (cdr (assoc 0 ent_data)) "LEADER")
	       (if (k_snapsnap_ucs "Führungspunkte")
		 (progn
		   (setq dummy_list (list))
		   (foreach data ent_data
		     (if (= (car data) 10)
		       (progn
			 (setq p (trans (cdr data) 0 1))
			 (setq
			   p
			    (trans (list (k_calc_snap (nth 0 p) snap_x)
					 (k_calc_snap (nth 1 p) snap_y)
				   )
				   1
				   0
			    )
			 )
			 (setq data (cons 10 p))
		       )
		     )
		     (setq dummy_list (cons data dummy_list))
		   )
		   (setq ent_data (reverse dummy_list))
		 )
	       )
	      )

	      ((= (cdr (assoc 0 ent_data)) "ACAD_TABLE")
	       (if (k_snapsnap_ucs "Tabellenlinien")
		 (progn
;;; Tabelle auf Raster
		   (setq obj_name (vlax-ename->vla-object ent_name))
		   (setq m 0)
		   (repeat (vla-get-rows obj_name)
		     (vla-setrowheight
		       obj_name
		       m
		       (k_calc_snap
			 (vla-getrowheight obj_name m)
			 snap_y
		       )
		     )
		     (setq m (1+ m))
		   )
		   (setq m 0)
		   (repeat (vla-get-columns obj_name)
		     (vla-setcolumnwidth
		       obj_name
		       m
		       (k_calc_snap
			 (vla-getcolumnwidth obj_name m)
			 snap_x
		       )
		     )
		     (setq m (1+ m))
		   )
		   (vla-put-insertionpoint
		     obj_name
		     (k_liste->variant
		       (list (k_calc_snap
			       (nth 0
				    (vlax-safearray->list
				      (vlax-variant-value
					(vla-get-insertionpoint obj_name)
				      )
				    )
			       )
			       snap_x
			     )
			     (k_calc_snap
			       (nth 1
				    (vlax-safearray->list
				      (vlax-variant-value
					(vla-get-insertionpoint obj_name)
				      )
				    )
			       )
			       snap_y
			     )
			     (k_calc_snap
			       (nth 2
				    (vlax-safearray->list
				      (vlax-variant-value
					(vla-get-insertionpoint obj_name)
				      )
				    )
			       )
			       snap_x
			     )
		       )
		       (vlax-variant-type
			 (vla-get-insertionpoint obj_name)
		       )
		     )
		   )
		   (setq ent_data nil)
		 )
	       )
	      )
	      (t nil)
	    )
	    (if	ent_data
	      (entmod ent_data)
	    )
	    (setq n (1- n))
	  )
	)
      )
      (if (k_acbc t nil)
	(command "_ucs" "ho" "entsnap")
	(command "_ucs" "b" "w" "entsnap")
      )
      (if (tblsearch "UCS" "entsnap")
	(command "_ucs" "l" "entsnap")
      )
					;      (setvar "snapang" snap_ang)
					;      (setvar "snapbase" snap_base)
					;      (setvar "aunits" mem_aunit)
    )
  )
  (k_restore_var '("aunits" "snapbase" "snapang" "snapunit"))
  (vla-endundomark (k_ac-doc))
  (princ)
)
;;; - ------------------------------------------------------------------------------ - ;
(princ
  (strcat
    "\nk_snapsnap:  Kontrollpunkte auf Fangraster bringen"
    "\n===========  "
    "\n(C) Andreas Kraus 2025 (info@kraus-cad.de)"
    "\nBefehlszeilenaufruf : k_snapsnap\n"
  )
)
;;; - ------------------------------------------------------------------------------ - ;
(princ)