;;; - ------------------------------------------------------------------------------ - ;
;;; -                 T O O L - K_DIMUPDATEX                                         - ;
;;; - ------------------------------------------------------------------------------ - ;
;;; - Beschreibung :  Bemaßungsdarstellung in Blöcken aktualisieren                  - ;
;;; - ------------------------------------------------------------------------------ - ;
;;; - Befehle      :  k_dimupdatex                                                   - ;
;;; - ------------------------------------------------------------------------------ - ;
;;; - letzte Änderung am : 14.05.2023                                                - ;
;;; -              durch : Andreas Kraus                                             - ;
;;; - ------------------------------------------------------------------------------ - ;

(vl-load-com)

(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))
	((= (TYPE NAME) (QUOTE LIST)) (CDR (ASSOC -1 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))
	)
	((= (TYPE NAME) (QUOTE LIST))
	 (vlax-ename->vla-object (CDR (ASSOC -1 NAME)))
	)
  )
)
(DEFUN K_AC-DOC	nil
  (vla-get-ActiveDocument (vlax-get-acad-object))
)
(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_COPYOBJECTS (OBJ_LIST QUELLE ZIEL RET / NEW_LIST)
  (IF (NULL QUELLE)
    (SETQ QUELLE (K_AC-DOC))
  )
  (COND	((= (TYPE OBJ_LIST) (QUOTE ENAME))
	 (SETQ OBJ_LIST (LIST (vlax-ename->vla-object OBJ_LIST)))
	)
	((= (TYPE OBJ_LIST) (QUOTE VLA-OBJECT))
	 (SETQ OBJ_LIST (LIST OBJ_LIST))
	)
	((= (TYPE OBJ_LIST) (QUOTE LIST))
	 (SETQ OBJ_LIST (MAPCAR (QUOTE K_->OBJ_NAME) OBJ_LIST))
	)
	(T nil)
  )
  (SETQ	OBJ_LIST (VL-REMOVE (QUOTE nil)
			    (MAPCAR (QUOTE
				      (LAMBDA (OBJ)
					(COND ((= (TYPE OBJ) (QUOTE ENAME)) (vlax-ename->vla-object OBJ))
					      ((= (TYPE OBJ) (QUOTE VLA-OBJECT)) OBJ)
					      (T nil)
					)
				      )
				    )
				    OBJ_LIST
			    )
		 )
  )
  (SETQ	NEW_LIST (VL-CATCH-ALL-APPLY
		   (QUOTE vlax-invoke)
		   (LIST QUELLE (QUOTE COPYOBJECTS) OBJ_LIST ZIEL)
		 )
  )
  (IF RET
    NEW_LIST
    nil
  )
)
(DEFUN K_GET_MERKLISTE (NAME / WERT)
  (IF (ASSOC NAME K_MERKLISTE)
    (SETQ WERT (NTH 1 (ASSOC NAME K_MERKLISTE)))
  )
  WERT
)
(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_ISNOT (WERT) (K_IS (K_NOT WERT)))
(DEFUN K_MEM_LAYSTAT (/ LAYSTATLIST LAY)
  (SETQ	LAYSTATLIST
	 (MAPCAR (QUOTE	(LAMBDA	(LAY)
			  (LIST	(vla-get-Name LAY)
				(vla-get-LayerOn LAY)
				(vla-get-Freeze LAY)
				(vla-get-Lock LAY)
			  )
			)
		 )
		 (K_COLLECTION->LIST (vla-get-Layers (K_AC-DOC)))
	 )
  )
  (K_PUT_MERKLISTE
    "k_mem_laystat"
    (VL-REMOVE (QUOTE nil)
	       (CONS LAYSTATLIST (K_GET_MERKLISTE "k_mem_laystat"))
    )
  )
  (PRINC)
)
(DEFUN K_NOT (WERT)
  (COND	((= WERT :vlax-false) :vlax-true)
	((= WERT :vlax-true) :vlax-false)
	((= WERT nil) T)
	((= WERT T) nil)
	((= WERT 1) 0)
	((= WERT 0) 1)
	((= WERT "1") "0")
	((= WERT "0") "1")
	((= (STRCASE WERT) "JA") "nein")
	((= (STRCASE WERT) "NEIN") "ja")
  )
)
(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_RST_LAYSTAT (/ OBJ_NAME DAT)
  (SETVAR "cmdecho" 0)
  (FOREACH DAT (CAR (K_GET_MERKLISTE "k_mem_laystat"))
    (IF	(AND (TBLSEARCH "LAYER" (NTH 0 DAT))
	     (SETQ OBJ_NAME (vla-Item (vla-get-Layers (K_AC-DOC)) (NTH 0 DAT)))
	)
      (PROGN (vla-put-LayerOn OBJ_NAME (NTH 1 DAT))
	     (IF (/= (CAR DAT) (GETVAR "clayer"))
	       (vla-put-Freeze OBJ_NAME (NTH 2 DAT))
	     )
	     (vla-put-Lock OBJ_NAME (NTH 3 DAT))
      )
    )
  )
  (IF (CDR (K_GET_MERKLISTE "k_mem_laystat"))
    (K_PUT_MERKLISTE
      "k_mem_laystat"
      (CDR (K_GET_MERKLISTE "k_mem_laystat"))
    )
  )
  (PRINC)
)

(defun c:k_dimupdatex (/ BLK-N ENT_DATA OBJ-N STILUPDATE TEMP_DATA TEMP_DIM)
;;;  Bemaßungsdarstellung in Blöcken aktualisieren
  (vla-startundomark (k_ac-doc))
  (initget "Ja Nein")
  (setq	stilupdate
	 (k_isnot
	   (getkword
	     "Stilüberschreibungen berücksichtigen ? : [Ja/Nein]"
	   )
	 )
  )
  (print)
  (setq	obj-n (apply '+
		     (mapcar 'vla-get-count
			     (k_collection->list (vla-get-blocks (k_ac-doc)))
		     )
	      )
  )
  (k_mem_laystat)
  (command "-layer" "ta" "*" "ent" "*" "ei" "*" "")
  (textscr)
  (setvar "cmdecho" 0)
  (setq blk-n (vla-get-count (vla-get-blocks (k_ac-doc))))
  (vlax-for blk	(vla-get-blocks (k_ac-doc))
    (setq blk-n (1- blk-n))
    (if	(not (k_is (vla-get-islayout blk)))
      (vlax-for	obj blk
	(princ (strcat "\rObjekt " (itoa (setq obj-n (1- obj-n)))))
	(if (member (vla-get-objectname obj)
		    '("AcDbRotatedDimension"		 "AcDbAlignedDimension"		    "AcDbArcDimension"
		      "AcDbRadialDimension"		 "AcDbRadialDimensionLarge"	    "AcDbDiametricDimension"
		      "AcDb2LineAngularDimension"	 "AcDb3PointAngularDimension"	    "AcDbOrdinateDimension"
		     )
	    )
	  (progn
	    (setq temp_dim (car	(k_copyobjects
				  obj
				  nil
				  (vla-get-modelspace
				    (k_ac-doc)
				  )
				  t
				)
			   )
	    )
	    (if	(VLAX-METHOD-APPLICABLE-P obj 'update)
	      (vla-update temp_dim)
	    )
	    (setq ent_data  (entget (k_->ent_name obj))
		  temp_data (entget (k_->ent_name temp_dim))
	    )
	    (if	stilupdate
	      (progn
		(command "_dimstyle"
			 "_restore"
			 (vla-get-stylename temp_dim)
		)
		(command "_dimstyle" "_apply" (k_->ent_name temp_dim) "")
		(setq ent_data (append ent_data '((-3 ("ACAD")))))
		(entmod ent_data)
	      )
	    )
	    (vla-move temp_dim
		      (vlax-3d-point '(0 0 0))
		      (vlax-3d-point
			(mapcar	'-
				(cdr
				  (assoc 10
					 (entget
					   (k_->ent_name
					     (car
					       (vl-remove-if-not
						 '(lambda (dummy) (= (vla-get-objectname dummy) "AcDbPoint"))
						 (k_collection->list
						   (vla-item (vla-get-blocks (k_ac-doc))
							     (cdr (assoc 2 ent_data))
						   )
						 )
					       )
					     )
					   )
					 )
				  )
				)
				(cdr
				  (assoc 10
					 (entget
					   (k_->ent_name
					     (car
					       (vl-remove-if-not
						 '(lambda (dummy) (= (vla-get-objectname dummy) "AcDbPoint"))
						 (k_collection->list
						   (vla-item (vla-get-blocks (k_ac-doc))
							     (cdr (assoc 2 temp_data))
						   )
						 )
					       )
					     )
					   )
					 )
				  )
				)
			)
		      )
	    )
	    (entmod (subst (assoc 2 (entget (k_->ent_name temp_dim)))
			   (assoc 2 ent_data)
			   ent_data
		    )
	    )
	    (vla-delete temp_dim)
	    (vla-delete
	      (vla-item	(vla-get-blocks (k_ac-doc))
			(cdr (assoc 2 ent_data))
	      )
	    )
	  )
	)
	(if (VLAX-METHOD-APPLICABLE-P obj 'update)
	  (vla-update obj)
	)
      )
    )
  )
  (k_rst_laystat)
  (vla-regen (k_ac-doc) 0)
  (vla-endundomark (k_ac-doc))
)
;;; - ------------------------------------------------------------------------------ - ;
(princ
  (strcat
    "\nk_dimupdatex:  Bemaßungsdarstellung in Blöcken aktualisieren"
    "\n===========  "
    "\n(C) Andreas Kraus 2023 (info@kraus-cad.de)"
    "\nBefehlszeilenaufruf : k_dimupdatex\n"
  )
)
;;; - ------------------------------------------------------------------------------ - ;
(princ)