;;; - ------------------------------------------------------------------------------ - ;
;;; -                 T O O L - K_DIMXY                                              - ;
;;; - ------------------------------------------------------------------------------ - ;
;;; - Beschreibung :  Punkte oder Objekte auf Achsen bemaßen                         - ;
;;; - ------------------------------------------------------------------------------ - ;
;;; - Befehle      :  k_dimxy                                                        - ;
;;; - ------------------------------------------------------------------------------ - ;
;;; - letzte Änderung am : 25.03.2025                                                - ;
;;; -              durch : Andreas Kraus                                             - ;
;;; - ------------------------------------------------------------------------------ - ;

(vl-load-com)
(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_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-DOC	nil
  (vla-get-ActiveDocument (vlax-get-acad-object))
)
(DEFUN K_AUSWAHL_LISTE_INPUT (REF_LISTE	    TITEL	  FILTER_LIST
			      /		    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 (GET_TILE "input"))
    (DONE_DIALOG)
  )
  (DEFUN AUSWAHL_LISTE_LISTE nil
    (SET_TILE "input"
	      (NTH (ATOI (GET_TILE "liste")) ANZEIGE_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)
  )
  (DEFUN AUSWAHL_LISTE_FILTER nil
    (SET_TILE "nicht"
	      (CADR (NTH (ATOI (GET_TILE "filter_list")) FILTER_LIST))
    )
    (AUSWAHL_LISTE_STELLE)
  )
  (DEFUN AUSWAHL_LISTE_INPUT nil
    (IF	(= $REASON 1)
      (END_AUSWAHL_LISTE 1)
    )
  )
  (SETQ N -1)
  (SETQ
    REF_LISTE (MAPCAR
		(QUOTE (LAMBDA (DATA) (SETQ N (1+ N)) (LIST DATA N)))
		REF_LISTE
	      )
  )
  (SETQ AUSWAHL_LISTE_ID (LOAD_DIALOG "k_dimxy.dcl"))
  (IF (NOT (NEW_DIALOG "auswahl_liste_input" 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)")
  (ACTION_TILE "input" "(auswahl_liste_input)")
  (START_LIST "filter_list")
  (MAPCAR (QUOTE ADD_LIST) (MAPCAR (QUOTE CAR) FILTER_LIST))
  (END_LIST)
  (ACTION_TILE "filter_list" "(auswahl_liste_filter)")
  (MODE_TILE "input" 2)
  (START_DIALOG)
  (UNLOAD_DIALOG AUSWAHL_LISTE_ID)
  (IF (= OK_AUSWAHL_LISTE 1)
    AUSWAHL
    nil
  )
)
(DEFUN K_BLK-P->LAYOUT-P (P INSLIST / ENT_DATA INS)
  (IF
    (AND
      (LISTP INSLIST)
      (VL-EVERY	(QUOTE (LAMBDA (DUMMY) (= (TYPE DUMMY) (QUOTE ENAME))))
		INSLIST
      )
    )
     (PROGN (SETQ P (K_3D->2D P))
	    (FOREACH INS INSLIST
	      (SETQ ENT_DATA (ENTGET INS))
	      (SETQ P
		     (MAPCAR
		       (QUOTE *)
		       P
		       (LIST (CDR (ASSOC 41 ENT_DATA)) (CDR (ASSOC 42 ENT_DATA)))
		     )
	      )
	      (SETQ
		P (MAPCAR (QUOTE +) P (K_3D->2D (CDR (ASSOC 10 ENT_DATA))))
	      )
	      (SETQ P (K_P_TWIST P
				 (CDR (ASSOC 10 ENT_DATA))
				 (CDR (ASSOC 50 ENT_DATA))
		      )
	      )
	    )
     )
  )
  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_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_GEOMCEN (OBJ_LIST)
  (DEFUN K_GEOMCEN_MIDP	(OBJ_NAME)
    (vla-GetBoundingBox OBJ_NAME (QUOTE MINP) (QUOTE MAXP))
    (K_MIDP (vlax-safearray->list MINP)
	    (vlax-safearray->list MAXP)
    )
  )
  (IF (LISTP OBJ_LIST)
    (MAPCAR (QUOTE K_GEOMCEN_MIDP) OBJ_LIST)
    (K_GEOMCEN_MIDP OBJ_LIST)
  )
)


(DEFUN K_GET_MERKLISTE (NAME / WERT)
  (IF (ASSOC NAME K_MERKLISTE)
    (SETQ WERT (NTH 1 (ASSOC NAME K_MERKLISTE)))
  )
  WERT
)
(DEFUN K_INTERSECT (ENT1 ENT2 EXTEND / AR)
  (SETQ ENT1 (K_->OBJ_NAME ENT1))
  (SETQ ENT2 (K_->OBJ_NAME ENT2))
  (COND	((= EXTEND 0)
	 (SETQ AR (vlax-invoke-method
		    ENT1
		    (QUOTE INTERSECTWITH)
		    ENT2
		    acExtendNone
		  )
	 )
	)
	((= EXTEND 1)
	 (SETQ AR (vlax-invoke-method
		    ENT1
		    (QUOTE INTERSECTWITH)
		    ENT2
		    acExtendThisEntity
		  )
	 )
	)
	((= EXTEND 2)
	 (SETQ AR (vlax-invoke-method
		    ENT1
		    (QUOTE INTERSECTWITH)
		    ENT2
		    acExtendOtherEntity
		  )
	 )
	)
	((= EXTEND 3)
	 (SETQ AR (vlax-invoke-method
		    ENT1
		    (QUOTE INTERSECTWITH)
		    ENT2
		    acExtendBoth
		  )
	 )
	)
  )
  (IF (/= -1
	  (vlax-safearray-get-u-bound (vlax-variant-value AR) 1)
      )
    (GATHER (vlax-safearray->list (vlax-variant-value AR)) 3)
  )
)
(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_MIDP (P1 P2)
  (SETQ MIDP (MAPCAR (QUOTE (LAMBDA (X1 X2) (/ (+ X1 X2) 2))) P1 P2))
)
(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_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_SATZ->OBJLIST (SATZ)
  (MAPCAR (QUOTE vlax-ename->vla-object)
	  (K_SATZ->ENTLIST SATZ)
  )
)
(DEFUN K_SAVE_VAR (VARLIST / K_SAVEVAR_LIST)
  (SETQ K_SAVEVAR_LIST (K_GET_MERKLISTE "k_savevar_list"))
  (IF (= (TYPE VARLIST) (QUOTE STR))
    (SETQ VARLIST (LIST VARLIST))
  )
  (FOREACH VAR VARLIST
    (IF	(ASSOC VAR K_SAVEVAR_LIST)
      (SETQ K_SAVEVAR_LIST
	     (SUBST (LIST VAR (GETVAR VAR))
		    (ASSOC VAR K_SAVEVAR_LIST)
		    K_SAVEVAR_LIST
	     )
      )
      (SETQ K_SAVEVAR_LIST
	     (CONS (LIST VAR (GETVAR VAR)) K_SAVEVAR_LIST)
      )
    )
  )
  (K_PUT_MERKLISTE "k_savevar_list" K_SAVEVAR_LIST)
)
(DEFUN K_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_ZAHLENREIHE (Z / N REIHE)
  (SETQ REIHE (LIST (1- (FIX Z))))
  (REPEAT (1- (FIX Z))
    (SETQ REIHE (CONS (1- (CAR REIHE)) REIHE))
  )
  REIHE
)
(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 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 (QUOTE ("_Ini")))
	   (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 c:k_dimxy (/	     ABSTAND	ACHSLAYER  BLK_LIST
		  DUMMY	     ENT_DATA	ENT_NAME   FILTER_LIST
		  INI_DATA   LAYER	LINE	   MEM_OSMODE
		  OBJ	     OBJ_LIST	OBJ_NAME   P
		  PIC	     PX		P_LIST	   TEMP-RAY
		  VEC	     VEC_LIST
		 )

  (defun k_dimxy_make_achslayer	()
    (if
      (not
	(member
	  achslayer
	  (mapcar 'vla-get-name
		  (k_collection->list (vla-get-layers (k_ac-doc)))
	  )
	)
      )
       (progn
	 (setq dummy (vla-add (vla-get-layers (k_ac-doc)) achslayer))
	 (vla-put-freeze dummy :vlax-true)
       )
    )
  )

  (defun k_dimxy_check_objektlayer ()
    (print
      "Objekt auf dem Layer, zu dessen Objekten bemaßt werden soll, wählen"
    )
    (setq pic	   (nentsel)
	  ent_data (entget (setq ent_name (car pic)))
	  layer	   (cdr (assoc 8 ent_data))
    )
    (if	(vl-every '(lambda (dummy) (= (type dummy) 'ENAME))
		  (last pic)
	)
      (setq blk_list (last pic))
      (setq
	blk_list (list
		   (vla-get-block
		     (vla-get-activelayout (k_ac-doc))
		   )
		 )
      )
    )
    (setq
      vec_list
       (apply
	 'append
	 (vl-remove
	   'nil
	   (mapcar
	     '(lambda (obj)
		(cond
		  ((and	(= (vla-get-layer obj) layer)
			(= (vla-get-objectname obj) "AcDbLine")
		   )
		   (list
		     (list (mapcar '*
				   (k_variant->value
				     (vla-get-StartPoint obj)
				   )
				   '(1.0 1.0 0.0)
			   )
			   (mapcar '*
				   (k_variant->value
				     (vla-get-EndPoint obj)
				   )
				   '(1.0 1.0 0.0)
			   )
		     )
		   )
		  )
		  ((and	(= (vla-get-layer obj) layer)
			(= (vla-get-objectname obj)
			   "AcDbPolyline"
			)
		   )
		   (setq p_list
			  (mapcar
			    '(lambda (p)
			       (setq p (1+ p))
			       (mapcar
				 '*
				 (VLAX-CURVE-GETPOINTATPARAM
				   obj
				   (1- p)
				 )
				 '(1.0 1.0 0.0)
			       )
			     )
			    (k_zahlenreihe
			      (1+
				(VLAX-CURVE-GETENDPARAM obj)
			      )
			    )
			  )
		   )
		   (mapcar 'list (i-cdr p_list) (cdr p_list))
		  )
		  (t nil)
		)
	      )
	     (k_collection->list
	       (vla-item
		 (vla-get-blocks (k_ac-doc))
		 (vla-get-name (k_->obj_name (car blk_list)))
	       )
	     )
	   )
	 )
       )
    )
    (setq
      blk_list (vl-remove
		 (vla-get-block
		   (vla-get-activelayout (k_ac-doc))
		 )
		 blk_list
	       )
    )
    (mapcar
      '(lambda (vec)
	 (setq
	   line	(vla-addline
		  (vla-get-block
		    (vla-get-activelayout (k_ac-doc))
		  )
		  (k_liste->variant
		    (append
		      (k_blk-p->layout-p (car vec) blk_list)
		      '(0.0)
		    )
		    8197
		  )
		  (k_liste->variant
		    (append
		      (k_blk-p->layout-p (cadr vec) blk_list)
		      '(0.0)
		    )
		    8197
		  )
		)
	 )
	 (vla-put-layer line achslayer)
       )
      vec_list
    )
    (setq obj_list
	   (k_satz->objlist
	     (ssget "x"
		    (list '(0 . "LINE,LWPOLYLINE")
			  (cons 8 achslayer)
		    )
	     )
	   )
    )
    (mapcar
      '(lambda (obj)
	 (cond
	   ((= (vla-get-objectname obj) "AcDbLine")
	    (vla-put-StartPoint
	      obj
	      (VLAX-3D-POINT
		(mapcar	'*
			(k_variant->value (vla-get-StartPoint obj))
			'(1.0 1.0 0.0)
		)
	      )
	    )
	    (vla-put-EndPoint
	      obj
	      (VLAX-3D-POINT
		(mapcar	'*
			(k_variant->value (vla-get-EndPoint obj))
			'(1.0 1.0 0.0)
		)
	      )
	    )
	   )
	   ((= (vla-get-objectname obj) "AcDbPolyline")
	    (vla-put-Elevation obj 0.0)
	   )
	 )
       )
      obj_list
    )
  )

  (vla-startundomark (k_ac-doc))
  (if (findfile	(strcat	(k_pathslash (k_get-ini-dir nil) nil)
			"k_dimxy.ini"
		)
      )
    (setq ini_data
	   (load (strcat (k_pathslash (k_get-ini-dir nil) nil)
			 "k_dimxy.ini"
		 )
	   )
    )
    (setq ini_data nil)
  )
  (if (not (setq abst (cadr ini_data)))
    (setq abst 150.0)
  )
  (while (not (setq achslayer (car ini_data)))
    (setq
      achslayer	(k_auswahl_liste_input
		  (mapcar
		    'vla-get-name
		    (k_collection->list (vla-get-layers (k_ac-doc)))
		  )
		  "Layer wählen"
		  filter_list
		)
    )
    (setq ini_data (list achslayer abst))
  )
  (k_dimxy_make_achslayer)
  (while (not (k_satz->entlist
		(ssget "x"
		       (list '(0 . "LINE")
			     (cons 8 achslayer)
		       )
		)
	      )
	 )
    (alert
      "keine Linien auf dem Layer gefunden, zu denen bemaßt werden kann"
    )
    (k_dimxy_check_objektlayer)
  )
  (setq	obj_list
	 (k_satz->objlist
	   (ssget "x"
		  (list	'(0 . "LINE,LWPOLYLINE")
			(cons 8 achslayer)
		  )
	   )
	 )
  )
  (while (null p)
    (initget 128)
    (setq dummy
	   (getpoint
	     "[Layer/Abstand/Objektlayer] Punkt wählen oder ENTER für Objektwahl : "
	   )
    )
    (cond
      ((= (type dummy) 'LIST)
       (setq p dummy)
      )
      ((and (= (type dummy) 'STR) (= (strcase dummy) "A"))
       (setq dummy (getdist (strcat "Abstand " (rtos abst) ": ")))
       (if dummy
	 (setq abst dummy)
       )
      )
      ((and (= (type dummy) 'STR) (= (strcase dummy) "L"))
       (setq
	 achslayer
	  (k_auswahl_liste_input
	    (mapcar
	      'vla-get-name
	      (k_collection->list (vla-get-layers (k_ac-doc)))
	    )
	    "Layer wählen"
	    filter_list
	  )
       )
       (setq ini_data (list achslayer abst))
       (k_dimxy_make_achslayer)
       (k_dimxy_check_achslayer)
      )
      ((and (= (type dummy) 'STR) (= (strcase dummy) "O"))
       (k_dimxy_check_objektlayer)
      )
      (t (setq p t))
    )
  )
  (if (= p t)
    (setq p nil)
  )
  (setq mem_osmode (getvar "osmode"))
  (setvar "osmode" 0)
  (if p
    (setq p_list (list p))
    (setq p_list
	   (mapcar
	     '(lambda (obj)
		(cond
		  ((= (vla-get-objectname obj) "AcDbBlockReference")
		   (k_variant->value (vla-get-insertionpoint obj))
		  )
		  (t
		   (k_geomcen obj)
		  )
		)
	      )
	     (k_satz->objlist (ssget))
	   )
    )
  )
  (foreach p p_list
    (setvar "osmode" 0)
    (setq
      px
       (car
	 (vl-sort
	   (vl-remove
	     'nil
	     (mapcar
	       '(lambda	(obj_name / TEMP-RAY px)
		  (setq	temp-ray
			 (vla-addray
			   (vla-get-modelspace (k_ac-doc))
			   (VLAX-3D-POINT p)
			   (VLAX-3D-POINT
			     (polar
			       p
			       (+
				 (angle	(VLAX-CURVE-GETSTARTPOINT
					  obj_name
					)
					(VLAX-CURVE-GETENDPOINT
					  obj_name
					)
				 )
				 (* pi 0.5)
			       )
			       1
			     )
			   )
			 )
		  )
		  (setq
		    px (car (k_intersect temp-ray obj_name 1))
		  )
		  (vla-delete temp-ray)
		  px
		)
	       (vl-remove-if
		 '(lambda (obj)
		    (or	(< (angle (VLAX-CURVE-GETSTARTPOINT obj)
				  (VLAX-CURVE-GETENDPOINT obj)
			   )
			   (* pi 0.25)
			)
			(< (* pi 0.75)
			   (angle (VLAX-CURVE-GETSTARTPOINT obj)
				  (VLAX-CURVE-GETENDPOINT obj)
			   )
			   (* pi 1.25)
			)
			(> (angle (VLAX-CURVE-GETSTARTPOINT obj)
				  (VLAX-CURVE-GETENDPOINT obj)
			   )
			   (* pi 1.75)
			)
		    )
		  )
		 obj_list
	       )
	     )
	   )
	   '(lambda (p1 p2) (< (distance p p1) (distance p p2)))
	 )
       )
    )
    (command "_dimaligned"
	     p
	     px
	     (polar p (+ (angle p px) (* pi 0.5)) abst)
    )
    (setvar "osmode" 0)
    (setq
      px
       (car
	 (vl-sort
	   (vl-remove
	     'nil
	     (mapcar
	       '(lambda	(obj_name / TEMP-RAY px)
		  (setq	temp-ray
			 (vla-addray
			   (vla-get-modelspace (k_ac-doc))
			   (VLAX-3D-POINT p)
			   (VLAX-3D-POINT
			     (polar
			       p
			       (+
				 (angle	(VLAX-CURVE-GETSTARTPOINT
					  obj_name
					)
					(VLAX-CURVE-GETENDPOINT
					  obj_name
					)
				 )
				 (* pi 0.5)
			       )
			       1
			     )
			   )
			 )
		  )
		  (setq
		    px (car (k_intersect temp-ray obj_name 1))
		  )
		  (vla-delete temp-ray)
		  px
		)
	       (vl-remove-if
		 '(lambda (obj)
		    (or	(<= (* pi 0.25)
			    (angle (VLAX-CURVE-GETSTARTPOINT obj)
				   (VLAX-CURVE-GETENDPOINT obj)
			    )
			    (* pi 0.75)
			)
			(<= (* pi 1.25)
			    (angle (VLAX-CURVE-GETSTARTPOINT obj)
				   (VLAX-CURVE-GETENDPOINT obj)
			    )
			    (* pi 1.75)
			)
		    )
		  )
		 obj_list
	       )
	     )
	   )
	   '(lambda (p1 p2) (< (distance p p1) (distance p p2)))
	 )
       )
    )
    (command "_dimaligned"
	     p
	     px
	     (polar p (+ (angle p px) (* pi 0.5)) abst)
    )
  )
  (vla-endundomark (k_ac-doc))
  (setvar "osmode" mem_osmode)

  (k_print_datei
    (strcat (k_pathslash (k_get-ini-dir nil) nil)
	    "k_dimxy.ini"
    )
    (list achslayer abst)
  )
  (princ)
)
;;; - ------------------------------------------------------------------------------ - ;
(princ
  (strcat
    "\nk_dimxy:  Punkte oder Objekte auf Achsen bemaßen"
    "\n===========  "
    "\n(C) Andreas Kraus 2024 (info@kraus-cad.de)"
    "\nBefehlszeilenaufruf : k_dimxy\n"
  )
)
;;; - ------------------------------------------------------------------------------ - ;
(princ)