;;; - ------------------------------------------------------------------------------ - ;
;;; -                 T O O L - K_VP-POS                                             - ;
;;; - ------------------------------------------------------------------------------ - ;
;;; - Beschreibung :  Inhalt von Ansichtsfenster positionieren                       - ;
;;; - ------------------------------------------------------------------------------ - ;
;;; - Befehle      :  K_vp-pos                                                       - ;
;;; - ------------------------------------------------------------------------------ - ;
;;; - letzte Änderung am : 04.10.2022                                                - ;
;;; -              durch : Andreas Kraus                                             - ;
;;; - ------------------------------------------------------------------------------ - ;

(vl-load-com)

(DEFUN K_AC-DOC	nil
  (vla-get-ActiveDocument (vlax-get-acad-object))
)

(DEFUN K_GET_MERKLISTE (NAME / WERT)
  (IF (ASSOC NAME K_MERKLISTE)
    (SETQ WERT (NTH 1 (ASSOC NAME K_MERKLISTE)))
  )
  WERT
)

(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_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_SSGET (TEXT ARGLIST / SATZ)
  (IF TEXT
    (PROGN
      (K_SAVE_VAR "NOMUTT")
      (PRINC (STRCAT " " TEXT))
      (SETVAR "NOMUTT" 1)
    )
  )
  (VL-CATCH-ALL-APPLY
    (LIST (QUOTE LAMBDA)
	  (QUOTE nil)
	  (QUOTE (SETQ SATZ (APPLY (QUOTE SSGET) ARGLIST)))
    )
  )
  (IF TEXT
    (K_RESTORE_VAR "NOMUTT")
  )
  SATZ
)

(defun c:k_vp-pos (/ FAKTOR P1 P2 PAP_MOD PX SATZ VP VPORT_NR VP_NR VP_P_DATA VP_P_MIDP VP_P_P1 VP_P_P2)
;;; Modellbereich positionieren
  (vla-startundomark (k_ac-doc))
  (if (= (getvar "tilemode") 0)
    (progn
      (setq pap_mod (getvar "cvport"))
      (command "_.pspace")
      (if (setq	satz (k_ssget "Ansichtsfenster wählen : "
			      '("_:S" ((0 . "VIEWPORT")))
		     )
	  )
	(progn
	  (setq vp (ssname satz 0))
	  (command "_.mspace")
	  (setq vport_nr (cdr (assoc 69 (entget vp))))
	  (command "cvport" vport_nr)
	  (command "_.ucs" "_delete" "k_vp-pos")
	  (command "_.ucs" "_save" "k_vp-pos")
	  (command "_.ucs" "_v")
	  (setq	p1    (getpoint "von Punkt")
		vp_nr (getvar "cvport")
	  )
	  (command "_.pspace")
	  (setq	vp_p_data (cdr (assoc vp_nr (vports)))
		vp_p_p1	  (append (car vp_p_data) (list '0.0))
		vp_p_p2	  (append (cadr vp_p_data) (list '0.0))
		vp_p_midp (mapcar '- vp_p_p2 vp_p_p1)
		p2	  (getpoint "nach Punkt")
	  )
	  (command "_.mspace")
	  (setq	faktor (/ (cadr vp_p_midp) (getvar "viewsize"))
		px     (mapcar '+
			       (getvar "viewctr")
			       (mapcar '/
				       (mapcar '-
					       p2
					       (mapcar '+ vp_p_p1 (mapcar '/ vp_p_midp '(2.0 2.0 2.0)))
				       )
				       (list faktor faktor faktor)
			       )
		       )
	  )
	  (command "_.-pan" p1 px)
	  (command "_.ucs" "_restore" "k_vp-pos")
	  (command "_.ucs" "_delete" "k_vp-pos")
	  (if (= pap_mod 1)
	    (command "_.pspace")
	  )
	  (vla-endundomark (k_ac-doc))
	)
	(alert "Bitte ein Ansichtsfenster wählen")
      )
    )
    (alert "bitte in ein Layout schalten")
  )
)
;;; - ------------------------------------------------------------------------------ - ;
(princ
  (strcat
    "\nK_vp-pos:  Inhalt von Ansichtsfenster positionieren"
    "\n===========  "
    "\n(C) Andreas Kraus 2022 (info@kraus-cad.de)"
    "\nBefehlszeilenaufruf : K_vp-pos\n"
  )
)
;;; - ------------------------------------------------------------------------------ - ;
(princ)