;;; - ------------------------------------------------------------------------------ - ;
;;; -                 T O O L - K_MANSFEN-LOCK                                       - ;
;;; - ------------------------------------------------------------------------------ - ;
;;; - Beschreibung :  Modellbereich-Ansichtsfenster sperren/entsperren               - ;
;;; - ------------------------------------------------------------------------------ - ;
;;; - Befehle      :  k_mansfen-lock                                                 - ;
;;; - ------------------------------------------------------------------------------ - ;
;;; - letzte Änderung am : 17.02.2025                                                - ;
;;; -              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))
	((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_AC-DOC	nil
  (vla-get-ActiveDocument (vlax-get-acad-object))
)
(DEFUN K_ALLE-OBJEKTE (FILE XREF SUBOBJ)
  (IF (NULL FILE)
    (SETQ FILE (K_AC-DOC))
  )
  (LENGTH (SETQ	BLK_LIST
		 (IF XREF
		   (K_COLLECTION->LIST (vla-get-Blocks FILE))
		   (PROGN
		     (SETQ
		       DUMMY (K_COLLECTION->LIST (vla-get-Blocks FILE))
		     )
		     (K_FILTER
		       (VL-REMOVE-IF-NOT
			 (QUOTE	(LAMBDA (BLK) (ENTGET (K_->ENT_NAME BLK)))
			 )
			 DUMMY
		       )
		       (QUOTE ((ISXREF :vlax-false)))
		     )
		   )
		 )
	  )
  )
  (SETQ ALLE_OBJ_LIST nil)
  (FOREACH BLK BLK_LIST
    (VLAX-FOR OBJ BLK
      (SETQ ALLE_OBJ_LIST (CONS OBJ ALLE_OBJ_LIST))
    )
  )
  (IF SUBOBJ
    (PROGN (LENGTH (SETQ ALLE_SUB_LIST
			  (VL-REMOVE-IF-NOT
			    (QUOTE
			      (LAMBDA (OBJ)
				(OR (= (vla-get-ObjectName OBJ)
				       "AcDb3dPolyline"
				    )
				    (AND (= (vla-get-ObjectName OBJ)
					    "AcDbBlockReference"
					 )
					 (K_IS (vla-get-HasAttributes OBJ))
				    )
				)
			      )
			    )
			    ALLE_OBJ_LIST
			  )
		   )
	   )
	   (LENGTH (SETQ ALLE_INS_LIST
			  (VL-REMOVE-IF-NOT
			    (QUOTE
			      (LAMBDA (OBJ)
				(AND (=	(vla-get-ObjectName OBJ)
					"AcDbBlockReference"
				     )
				     (K_IS (vla-get-HasAttributes OBJ))
				)
			      )
			    )
			    ALLE_SUB_LIST
			  )
		   )
	   )
	   (SETQ ALLE_ATT_LIST
		  (APPLY (QUOTE APPEND)
			 (MAPCAR (QUOTE K_GET-ATTS) ALLE_INS_LIST)
		  )
	   )
	   (LENGTH (SETQ ALLE_POLYLINE_LIST
			  (VL-REMOVE-IF-NOT
			    (QUOTE (LAMBDA (OBJ)
				     (=	(vla-get-ObjectName OBJ)
					"AcDb3dPolyline"
				     )
				   )
			    )
			    ALLE_SUB_LIST
			  )
		   )
	   )
	   (SETQ ALLE_OBJ_LIST
		  (APPEND
		    ALLE_OBJ_LIST
		    (APPLY
		      (QUOTE APPEND)
		      (MAPCAR
			(QUOTE
			  (LAMBDA (PL_OBJ / VERTEX_LIST)
			    (SETQ ENT_NAME (vlax-vla-object->ename
					     PL_OBJ
					   )
				  ENT_DATA (ENTGET ENT_NAME)
			    )
			    (WHILE
			      (/= (CDR (ASSOC 0 ENT_DATA)) "SEQEND")
			       (IF (= (CDR (ASSOC 0 ENT_DATA))
				      "VERTEX"
				   )
				 (SETQ VERTEX_LIST
					(CONS
					  (vlax-ename->vla-object
					    ENT_NAME
					  )
					  VERTEX_LIST
					)
				 )
			       )
			       (SETQ ENT_NAME (ENTNEXT ENT_NAME)
				     ENT_DATA (ENTGET ENT_NAME)
			       )
			    )
			    VERTEX_LIST
			  )
			)
			ALLE_POLYLINE_LIST
		      )
		    )
		  )
	   )
	   (SETQ ALLE_OBJ_LIST (APPEND ALLE_OBJ_LIST ALLE_ATT_LIST))
    )
  )
  ALLE_OBJ_LIST
)
(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_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-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_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_MEM_LAYSTAT (DOC / LAYSTATLIST LAY)
  (IF (NULL DOC)
    (SETQ DOC (K_AC-DOC))
  )
  (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 DOC))
	 )
  )
  (K_PUT_MERKLISTE
    (STRCAT "k_mem_laystat_" (VL-PRINC-TO-STRING DOC))
    (VL-REMOVE (QUOTE nil)
	       (CONS LAYSTATLIST
		     (K_GET_MERKLISTE
		       (STRCAT "k_mem_laystat_" (VL-PRINC-TO-STRING DOC))
		     )
	       )
    )
  )
  (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_RST_LAYSTAT (DOC / OBJ_NAME DAT LAYER_LIST)
  (SETVAR "cmdecho" 0)
  (IF (NULL DOC)
    (SETQ DOC (K_AC-DOC))
  )
  (FOREACH DAT
	   (CAR	(K_GET_MERKLISTE
		  (STRCAT "k_mem_laystat_" (VL-PRINC-TO-STRING DOC))
		)
	   )
    (SETQ LAYER_LIST
	   (MAPCAR (QUOTE vla-get-Name)
		   (K_COLLECTION->LIST (vla-get-Layers DOC))
	   )
    )
    (IF
      (AND (MEMBER (NTH 0 DAT) LAYER_LIST)
	   (SETQ OBJ_NAME (vla-Item (vla-get-Layers 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
	     (STRCAT "k_mem_laystat_" (VL-PRINC-TO-STRING DOC))
	   )
      )
    (K_PUT_MERKLISTE
      (STRCAT "k_mem_laystat_" (VL-PRINC-TO-STRING DOC))
      (CDR (K_GET_MERKLISTE
	     (STRCAT "k_mem_laystat_" (VL-PRINC-TO-STRING DOC))
	   )
      )
    )
  )
  (PRINC)
)
(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 c:k_mansfen-lock	(/ wahl doc_list obj_name)
;;;  Ansichtsfenster sperren oder entsperren
  (initget "Sperren Entsperren XSperren XEntsperren")
  (setq wahl (getkword "[Sperren/Entsperren/XSperren/XEntsperren]"))
  (cond
    ((= wahl "Sperren")
     (setq wahl :vlax-true)
     (setq doc_list (list (k_ac-doc)))
    )
    ((= wahl "Entsperren")
     (setq wahl :vlax-false)
     (setq doc_list (list (k_ac-doc)))
    )
    ((= wahl "XSperren")
     (setq wahl :vlax-true)
     (setq doc_list (k_collection->list
		      (vla-get-documents (vlax-get-acad-object))
		    )
     )
    )
    ((= wahl "XEntsperren")
     (setq wahl :vlax-false)
     (setq doc_list (k_collection->list
		      (vla-get-documents (vlax-get-acad-object))
		    )
     )
    )
  )
  (foreach doc doc_list
    (k_mem_laystat doc)
    (vlax-for lay (vla-get-layers
		    doc
		  )
      (vla-put-lock lay :vlax-false)
    )
    (foreach obj_name (vl-remove-if-not
			'(lambda (obj)
			   (= (vla-get-objectname obj) "AcDbViewport")
			 )
			(k_alle-objekte doc nil nil)
		      )
      (vla-put-displaylocked obj_name wahl)
    )
    (k_rst_laystat doc)
  )
  (princ)
)
;;; - ------------------------------------------------------------------------------ - ;
(princ
  (strcat
    "\nk_mansfen-lock:  Modellbereich-Ansichtsfenster sperren/entsperren"
    "\n===========  "
    "\n(C) Andreas Kraus 2024 (info@kraus-cad.de)"
    "\nBefehlszeilenaufruf : k_mansfen-lock\n"
  )
)
;;; - ------------------------------------------------------------------------------ - ;
(princ)