;;; - ------------------------------------------------------------------------------ - ;
;;; -                 T O O L - K_MOVE-DIMCHAIN                                      - ;
;;; - ------------------------------------------------------------------------------ - ;
;;; - Beschreibung :  Bemaßungskette positionieren                                   - ;
;;; - ------------------------------------------------------------------------------ - ;
;;; - Befehle      :  k_move-dimchain                                                - ;
;;; - ------------------------------------------------------------------------------ - ;
;;; - letzte Änderung am : 07.07.2025                                                - ;
;;; -              durch : Andreas Kraus                                             - ;
;;; - ------------------------------------------------------------------------------ - ;

(vl-load-com)
(DEFUN COMPARE (E0 E1 /)
  (COND	((> (CAR E0) (CAR E1)) 1)
	((< (CAR E0) (CAR E1)) -1)
	((QUOTE T) 0)
  )
)
(DEFUN K_->ENT_NAME (NAME)
  (COND	((= (TYPE NAME) (QUOTE ENAME)) NAME)
	((= (TYPE NAME) (QUOTE VLA-OBJECT))
	 (vlax-vla-object->ename NAME)
	)
	((= (TYPE NAME) (QUOTE STR)) (HANDENT NAME))
	((AND (= (TYPE NAME) (QUOTE LIST)) (ASSOC -1 NAME))
	 (CDR (ASSOC -1 NAME))
	)
	((AND (= (TYPE NAME) (QUOTE LIST)) (ASSOC 5 NAME))
	 (HANDENT (CDR (ASSOC 5 NAME)))
	)
  )
)
(DEFUN K_->OBJ_NAME (NAME)
  (COND	((= (TYPE NAME) (QUOTE ENAME))
	 (vlax-ename->vla-object NAME)
	)
	((= (TYPE NAME) (QUOTE VLA-OBJECT)) NAME)
	((= (TYPE NAME) (QUOTE STR))
	 (vlax-ename->vla-object (HANDENT NAME))
	)
	((AND (= (TYPE NAME) (QUOTE LIST)) (ASSOC -1 NAME))
	 (vlax-ename->vla-object (CDR (ASSOC -1 NAME)))
	)
	((AND (= (TYPE NAME) (QUOTE LIST)) (ASSOC 5 NAME))
	 (vlax-ename->vla-object (HANDENT (CDR (ASSOC 5 NAME))))
	)
  )
)
(DEFUN K_AC-DOC	nil
  (vla-get-ActiveDocument (vlax-get-acad-object))
)
(DEFUN K_ACBC (DUMMY1 DUMMY2)
  (IF (AND (VL-STRING-SEARCH "BricsCAD" (GETVAR "acadver")))
    DUMMY2
    DUMMY1
  )
)
(DEFUN K_ENTLIST->SATZ (ENT_LIST / N SATZ ENT_NAME)
  (IF (NOT (LISTP ENT_LIST))
    (SETQ ENT_LIST (LIST ENT_LIST))
  )
  (IF (LISTP ENT_LIST)
    (PROGN (SETQ SATZ (SSADD))
	   (MAPCAR
	     (QUOTE
	       (LAMBDA (ENT_NAME)
		 (COND ((AND (= (TYPE ENT_NAME) (QUOTE VLA-OBJECT))
			     (K_->ENT_NAME ENT_NAME)
			)
			(SETQ
			  SATZ (SSADD (vlax-vla-object->ename ENT_NAME) SATZ)
			)
		       )
		       ((AND (= (TYPE ENT_NAME) (QUOTE ENAME))
			     (K_->OBJ_NAME ENT_NAME)
			)
			(SETQ SATZ (SSADD ENT_NAME SATZ))
		       )
		       ((= (TYPE ENT_NAME) (QUOTE STR))
			(IF (HANDENT ENT_NAME)
			  (SETQ SATZ (SSADD (HANDENT ENT_NAME) SATZ))
			)
		       )
		 )
	       )
	     )
	     ENT_LIST
	   )
    )
  )
  SATZ
)
(DEFUN K_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_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 L-2NDINHIBITION (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 L2 (CONS (CDAR L0) L2)
		 L0 (CDR L0)
	   )
	  )
	  ((= CMP 1) (SETQ L1 (CDR L1)))
	  ((QUOTE T)
	   (SETQ L0 (CDR L0)
		 L1 (CDR L1)
	   )
	  )
    )
  )
  (APPEND L2 (MAPCAR (QUOTE CDR) L0))
)
(DEFUN MAKE-SORTABLE (L /)
  (MAPCAR (QUOTE (LAMBDA (E /) (CONS (VL-PRIN1-TO-STRING E) E)))
	  L
  )
)
(DEFUN _< (E0 E1 /) (< (CAR E0) (CAR E1)))

(defun c:k_move-dimchain (/	     CHECK_DATA	CHECK_DIM  CHECK_W
			  D	     DIM_LIST	DIM_LIST_ALT
			  DUMMY	     ENT	ENT_DATA   ENT_LIST
			  ENT_NAME   P1		P2	   PX
			  P_LIST     TOLERANZ	VIEWCTR	   VIEWSIZE
			  WEITER
			 )
					; Bemaßungskette verschieben
  (defun k_move-dimchain_p2 (p1 ent_data / ent_data_mem p2)
    (setq ent_data_mem ent_data)
    (if	(equal (cdr (assoc 10 ent_data))
	       (cdr (assoc 14 ent_data))
	       0.00001
	)
      (setq
	ent_data (entmod
		   (subst
		     (cons 10
			   (polar (cdr (assoc 10 ent_data))
				  (+ (angle (cdr (assoc 13 ent_data))
					    (cdr (assoc 14 ent_data))
				     )
				     (* pi 0.5)
				  )
				  1
			   )
		     )
		     (assoc 10 ent_data)
		     ent_data
		   )
		 )
      )
    )
    (setq p2 (inters (cdr (assoc 13 ent_data))
		     (polar (cdr (assoc 13 ent_data))
			    (angle (cdr (assoc 10 ent_data))
				   (cdr (assoc 14 ent_data))
			    )
			    1
		     )
		     (cdr (assoc 10 ent_data))
		     (polar (cdr (assoc 10 ent_data))
			    (+ (angle (cdr (assoc 10 ent_data))
				      (cdr (assoc 14 ent_data))
			       )
			       (* pi 0.5)
			    )
			    1
		     )
		     nil
	     )
    )
    (entmod ent_data_mem)
    p2
  )

  (vla-startundomark (k_ac-doc))
  (setq	check_dim    (car
		       (k_satz->entlist (ssget "_+.:E:S" '((0 . "DIMENSION"))))
		     )
	check_data   (entget check_dim)
	p1	     (cdr (assoc 10 check_data))
	p2	     (k_move-dimchain_p2 p1 check_data)
	check_w	     (rem (if (member '(100 . "AcDbRotatedDimension") check_data)
			    (cdr (assoc 50 check_data))
			    (angle p1 p2)
			  )
			  pi
		     )
	p_list	     (list p1 p2)
	dim_list_alt nil
	d	     (*	(vla-get-ArrowheadSize (k_->obj_name check_data))
			(vla-get-ScaleFactor (k_->obj_name check_data))
		     )
	viewctr	     (getvar "viewctr")
	viewsize     (getvar "viewsize")
	toleranz     (* d 0.01)
	ent	     (nth 0
			  (k_satz->entlist (ssget "_c" p1 p2 '((0 . "DIMENSION"))))
		     )
	weiter	     t
  )
  (while weiter
    (setq p_list   (list p1 p2)
	  dim_list (vl-remove-if-not
		     '(lambda (ent / ent_data p1_temp p2_temp)
			(setq ent_data (entget ent))
			(setq p1_temp (cdr (assoc 10 ent_data)))
			(setq p2_temp
			       (k_move-dimchain_p2 p1_temp ent_data)
			)
			(and
			  (equal
			    check_w
			    (rem (if (member '(100 . "AcDbRotatedDimension")
					     ent_data
				     )
				   (cdr (assoc 50 ent_data))
				   (angle p1_temp p2_temp)
				 )
				 pi
			    )
			    toleranz
			  )
			  (or (equal p1 p1_temp toleranz)
			      (equal p1 p2_temp toleranz)
			      (equal p2 p1_temp toleranz)
			      (equal p2 p2_temp toleranz)
			  )
			)
		      )
		     (k_satz->entlist
		       (ssget "_c" p1 p2 '((0 . "DIMENSION")))
		     )
		   )
    )
    (if	(setq weiter (l-2ndinhibition dim_list dim_list_alt))
      (progn
	(setq dim_list_alt (k_purge_list (append dim_list_alt dim_list))
	      p_list	   (apply
			     'append
			     (mapcar '(lambda (ent)
					(setq ent_data (entget ent))
					(list (setq p1 (cdr (assoc 10 ent_data)))
					      (setq p2
						     (k_move-dimchain_p2 p1 ent_data)
					      )
					)
				      )
				     dim_list
			     )
			   )
	      dummy	   (car
			     (vl-sort
			       (apply
				 'append
				 (mapcar '(lambda (p1)
					    (mapcar '(lambda (p2)
						       (list (distance p1 p2) p1 p2)
						     )
						    p_list
					    )
					  )
					 p_list
				 )
			       )
			       '(lambda (q1 q2) (> (car q1) (car q2)))
			     )
			   )
	      p1	   (cadr dummy)
	      p2	   (caddr dummy)
	)
	(command "_zoom" p1 p2)
      )
    )
  )

  (if (and viewctr viewsize)
    (command "_zoom" "_c" viewctr viewsize)
  )
  (mapcar '(lambda (ent_name)
	     (redraw ent_name 3)
	   )
	  dim_list_alt
  )
  (if (not (setq px
		  (getpoint
		    "Basispunkt der Verschiebung oder ENTER für automatische Wahl : "
		  )
	   )
      )
    (setq px (cdr (assoc 10 check_data)))
  )
  (setq	p_list (list (polar (polar p1 (angle p2 p1) d)
			    (+ (angle p1 p2) (/ pi 2.0))
			    d
		     )
		     (polar (polar p1 (angle p2 p1) d)
			    (- (angle p1 p2) (/ pi 2.0))
			    d
		     )
		     (polar (polar p2 (angle p1 p2) d)
			    (- (angle p1 p2) (/ pi 2.0))
			    d
		     )
		     (polar (polar p2 (angle p1 p2) d)
			    (+ (angle p1 p2) (/ pi 2.0))
			    d
		     )
	       )
  )
;;; Bemaßungsdaten merken um ggf. Maßpunkte wieder herzustellen
  (setq dim_list_data (mapcar 'entget dim_list_alt))
;;;  Positionieren
  (if (k_acbc t nil)
    (if	(setq ent_list (l-2ndinhibition
			 (k_satz->entlist (ssget "_cp" p_list))
			 dim_list_alt
		       )
	)
      (command "_stretch"
	       "_cp"
	       (nth 0 p_list)
	       (nth 1 p_list)
	       (nth 2 p_list)
	       (nth 3 p_list)
	       ""
	       "ent"
	       (k_entlist->satz ent_list)
	       ""
	       px
	       pause
      )
      (command "_stretch"
	       "_cp"
	       (nth 0 p_list)
	       (nth 1 p_list)
	       (nth 2 p_list)
	       (nth 3 p_list)
	       ""
	       ""
	       px
	       pause
      )
    )
    (if	(setq ent_list (l-2ndinhibition
			 (k_satz->entlist (ssget "_cp" p_list))
			 dim_list_alt
		       )
	)
      (command "_stretch"
	       "_cp"
	       p_list
	       ""
	       "ent"
	       (k_entlist->satz ent_list)
	       ""
	       px
	       pause
      )
      (command "_stretch" "_cp" p_list "" "" px pause)
    )
  )
;;; Maßpunkte wieder herstellen
  (foreach dim_data dim_list_data
    (setq ent_data (entget (cdr (assoc -1 dim_data))))
    (setq ent_data
	   (subst (assoc 13 dim_data) (assoc 13 ent_data) ent_data)
    )
    (setq ent_data
	   (subst (assoc 14 dim_data) (assoc 14 ent_data) ent_data)
    )
    (entmod ent_data)
  )
  (vla-endundomark (k_ac-doc))
  (princ)
)

;;; - ------------------------------------------------------------------------------ - ;
(princ
  (strcat
    "\nk_move-dimchain:  Bemaßungskette positionieren"
    "\n===========  "
    "\n(C) Andreas Kraus 2024 (info@kraus-cad.de)"
    "\nBefehlszeilenaufruf : k_move-dimchain\n"
  )
)
;;; - ------------------------------------------------------------------------------ - ;
(princ)