;;; - ------------------------------------------------------------------------------ - ;
;;; -                 T O O L - K_MARKER                                             - ;
;;; - ------------------------------------------------------------------------------ - ;
;;; - Beschreibung :  Markierungen erstellen                                         - ;
;;; - ------------------------------------------------------------------------------ - ;
;;; - Befehle      :  k_marker                                                       - ;
;;; - ------------------------------------------------------------------------------ - ;
;;; - letzte Änderung am : 24.05.2024                                                - ;
;;; -              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 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 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_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_AC-LAYOUT (FILE)
  (IF FILE
    (vla-get-ActiveLayout FILE)
    (vla-get-ActiveLayout (K_AC-DOC))
  )
)
(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_GET_ASSOC (LISTE GRUPPE)
  (IF (/= (TYPE GRUPPE) (QUOTE LIST))
    (SETQ GRUPPE (LIST GRUPPE))
  )
  (VL-REMOVE-IF-NOT
    (QUOTE (LAMBDA (DATA) (MEMBER (CAR DATA) GRUPPE)))
    LISTE
  )
)
(DEFUN K_GET_MERKLISTE (NAME / WERT)
  (IF (ASSOC NAME K_MERKLISTE)
    (SETQ WERT (NTH 1 (ASSOC NAME K_MERKLISTE)))
  )
  WERT
)
(DEFUN K_INPUT_DIALOG (ART INH TEXT / K_INPUT_DIALOG_ID OK)
  (DEFUN K_INPUT_DIALOG_END (WERT)
    (SETQ INH_NEU (GET_TILE "inh"))
    (SETQ OK WERT)
    (DONE_DIALOG WERT)
  )
  (DEFUN K_INPUT_DIALOG_INH nil
    (IF	(= $REASON 1)
      (K_INPUT_DIALOG_END (QUOTE 1))
    )
  )
  (SETQ ART (STRCASE ART))
  (IF (/= (TYPE INH) (QUOTE STR))
    (SETQ INH (VL-PRIN1-TO-STRING INH))
  )
  (SETQ K_INPUT_DIALOG_ID (LOAD_DIALOG "k_marker.dcl"))
  (IF (NOT (NEW_DIALOG "k_input_dialog" K_INPUT_DIALOG_ID))
    (EXIT)
  )
  (IF TEXT
    (SET_TILE "text" (VL-PRINC-TO-STRING TEXT))
  )
  (SET_TILE "inh" INH)
  (MODE_TILE "inh" 2)
  (ACTION_TILE "inh" "(k_input_dialog_inh)")
  (ACTION_TILE "accept" "(k_input_dialog_end '1)")
  (ACTION_TILE "cancel" "(k_input_dialog_end '0)")
  (START_DIALOG)
  (UNLOAD_DIALOG K_INPUT_DIALOG_ID)
  (IF (= OK 1)
    (COND ((OR (= ART "INTEGER") (= ART "INT"))
	   (SETQ INH (ATOI INH_NEU))
	  )
	  ((= ART "REAL") (SETQ INH (ATOF INH_NEU)))
	  ((OR (= ART "STRING") (= ART "TEXT")) (SETQ INH INH_NEU))
	  ((OR (= ART "KOORDINATE") (= ART "COORD") (= ART "PUNKT"))
	   (SETQ INH (READ INH_NEU))
	  )
	  ((= ART "LISTE") (SETQ INH (READ INH_NEU)))
    )
    (COND ((OR (= ART "INTEGER") (= ART "INT")) (SETQ INH (ATOI INH)))
	  ((= ART "REAL") (SETQ INH (ATOF INH)))
	  ((OR (= ART "STRING") (= ART "TEXT")) (SETQ INH INH))
	  ((OR (= ART "KOORDINATE") (= ART "COORD") (= ART "PUNKT"))
	   (SETQ INH (READ INH))
	  )
	  ((= ART "LISTE") (SETQ INH (READ INH)))
    )
  )
  INH
)
(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_LASTOBJECTS (ENT / ENT_LIST)
  (SETQ ENT (K_->ENT_NAME ENT))
  (WHILE (NOT (EQUAL (SETQ ENT (ENTNEXT ENT)) (ENTLAST)))
    (SETQ ENT_LIST (CONS ENT ENT_LIST))
  )
  (SETQ ENT_LIST (CONS ENT ENT_LIST))
  (MAPCAR (QUOTE K_->OBJ_NAME) ENT_LIST)
)
(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_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_OBJLIST->SATZ (OBJ_LIST)
  (IF (NOT (LISTP OBJ_LIST))
    (SETQ OBJ_LIST (LIST OBJ_LIST))
  )
  (K_ENTLIST->SATZ
    (MAPCAR (QUOTE vlax-vla-object->ename) OBJ_LIST)
  )
)
(DEFUN K_PL-INSEL (PL_LIST)
  (SETQ	PL_LIST	(VL-REMOVE (QUOTE nil)
			   (MAPCAR (QUOTE K_->OBJ_NAME) PL_LIST)
		)
  )
  (VL-REMOVE (QUOTE nil)
	     (MAPCAR (QUOTE
		       (LAMBDA (PL / P1 P2 RAY I_LIST)
			 (SETQ CHECKLIST (VL-REMOVE PL PL_LIST))
			 (SETQ P1     (vlax-curve-getStartPoint PL)
			       P2     (POLAR P1 0 1)
			       RAY    (vla-AddRay
					(vla-get-ModelSpace (K_AC-DOC))
					(vlax-3d-point P1)
					(vlax-3d-point P2)
				      )
			       I_LIST (VL-REMOVE (QUOTE nil)
						 (MAPCAR (QUOTE	(LAMBDA	(CHECK)
								  (IF (NOT (K_INTERSECT PL CHECK 0))
								    (K_INTERSECT RAY CHECK 0)
								  )
								)
							 )
							 CHECKLIST
						 )
				      )
			 )
			 (vla-Delete RAY)
			 (IF (VL-REMOVE-IF
			       (QUOTE (LAMBDA (Q) (= (REM (LENGTH Q) 2) 0)))
			       I_LIST
			     )
			   PL
			 )
		       )
		     )
		     PL_LIST
	     )
  )
)
(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_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_ZAHLENREIHE (Z / N REIHE)
  (SETQ REIHE (LIST Z))
  (REPEAT (FIX Z) (SETQ REIHE (CONS (1- (CAR REIHE)) REIHE)))
  REIHE
)
(DEFUN K_ZAHLENREIHE_START (Z START)
  (MAPCAR (QUOTE (LAMBDA (N) (+ START N))) (K_ZAHLENREIHE Z))
)
(DEFUN K_ZAHLENREIHE_START_STEP	(Z START STEP)
  (MAPCAR (QUOTE (LAMBDA (N) (+ START (* STEP N))))
	  (K_ZAHLENREIHE_START Z 0)
  )
)
(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 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 _< (E0 E1 /) (< (CAR E0) (CAR E1)))

(defun c:k_marker (/ B_LIST CIRCLE_OBJ COLOR D DUMMY ENT_DAT ENT_DATA ENT_LAST ENT_NAME	E_LIST E_NAME INSEL_LIST K_ERR MODUS OBJ OLDERR	P PEN P_ALT REGION-OBJ SATZ TRANSPARENCY)
;;;  Marker
  (defun k_err (fc)
    (print "error")
    (vla-endundomark (k_ac-doc))
    (command "._U")
    (k_restore_var '("cmdecho" "NOMUTT"))
    (setq *error* olderr)
  )

  (defun k_marker_show (c)
    (if	p
      (if pen
	(grvecs	(list c
		      (polar p 0 (/ d 2.0))
		      (polar p (* pi 0.25) (/ d 2.0))
		      c
		      (polar p (* pi 0.25) (/ d 2.0))
		      (polar p (* pi 0.5) (/ d 2.0))
		      c
		      (polar p (* pi 0.5) (/ d 2.0))
		      (polar p (* pi 0.75) (/ d 2.0))
		      c
		      (polar p (* pi 0.75) (/ d 2.0))
		      (polar p (* pi 1.0) (/ d 2.0))
		      c
		      (polar p (* pi 1.0) (/ d 2.0))
		      (polar p (* pi 1.25) (/ d 2.0))
		      c
		      (polar p (* pi 1.25) (/ d 2.0))
		      (polar p (* pi 1.5) (/ d 2.0))
		      c
		      (polar p (* pi 1.5) (/ d 2.0))
		      (polar p (* pi 1.75) (/ d 2.0))
		      c
		      (polar p (* pi 1.75) (/ d 2.0))
		      (polar p (* pi 2.0) (/ d 2.0))
		)
	)
	(grvecs	(list c
		      (polar p 0 (/ d 2.0))
		      (polar p (* pi 0.125) (/ d 2.0))
		      c
		      (polar p (* pi 0.25) (/ d 2.0))
		      (polar p (* pi 0.375) (/ d 2.0))
		      c
		      (polar p (* pi 0.5) (/ d 2.0))
		      (polar p (* pi 0.625) (/ d 2.0))
		      c
		      (polar p (* pi 0.75) (/ d 2.0))
		      (polar p (* pi 0.875) (/ d 2.0))
		      c
		      (polar p (* pi 1.0) (/ d 2.0))
		      (polar p (* pi 1.125) (/ d 2.0))
		      c
		      (polar p (* pi 1.25) (/ d 2.0))
		      (polar p (* pi 1.375) (/ d 2.0))
		      c
		      (polar p (* pi 1.5) (/ d 2.0))
		      (polar p (* pi 1.625) (/ d 2.0))
		      c
		      (polar p (* pi 1.75) (/ d 2.0))
		      (polar p (* pi 1.875) (/ d 2.0))
		)
	)
      )
    )
  )

  (vla-startundomark (k_ac-doc))
  (setq	olderr	*error*
	*error*	k_err
  )
  (*push-error-using-command*)
  (setq	pen	     nil
	d	     (/ (getvar "viewsize") 15.0)
	satz	     (ssadd)
	p_alt	     '(0 0)
	p	     (cadr (grread t 7 0))
	modus	     "add"
	ent_last     (entlast)
	color	     50
	transparency 25
  )
  (if (k_get_merkliste "k_marker")
    (mapcar 'set
	    '(color transparency d)
	    (k_get_merkliste "k_marker")
    )
  )
  (k_put_merkliste "k_marker" (list color transparency d))
  (k_marker_show 256)
  (k_save_var '("cmdecho" "NOMUTT"))
  (setvar "cmdecho" 0)
  (setvar "NOMUTT" 1)
  (print
    "d=Durchmesser, c=Color, t=Transparenz, e=Erweitern, +=Add, -=Sub, LMT=Stift heben/senken, RMT=Fertig"
  )
  (while (/= (car (setq dummy (grread t 7 0))) (k_acbc 25 12))
    (k_marker_show 256)
    (redraw)
    (cond
      ((= (car dummy) 2)
       (cond
	 ((member (cadr dummy) '(67 99))
	  (setq color (acad_colordlg 51 t))
	  (k_put_merkliste "k_marker" (list color transparency d))
	  (setq pen nil)
	 )
	 ((member (cadr dummy) '(84 116))
	  (setq transparency (k_input_dialog "Int" transparency "Transparenz"))
	  (k_put_merkliste "k_marker" (list color transparency d))
	  (setq pen nil)
	 )
	 ((member (cadr dummy) '(68 100))
	  (setq d (k_input_dialog "Real" d "Durchmesser"))
	  (k_put_merkliste "k_marker" (list color transparency d))
	  (setq pen nil)
	 )
	 ((member (cadr dummy) '(69 101))
	  (if (setq ent_name (car (entsel)))
	    (progn
	      (setq ent_data (entget ent_name))
	      (print (cdr (assoc 0 ent_data)))
	      (cond
		((= (cdr (assoc 0 ent_data)) "REGION")
		 (setq satz (ssadd ent_name))
		 (if
		   (= (cdr (assoc 0 (entget (cdr (assoc 330 ent_data)))))
		      "HATCH"
		   )
		    (entdel
		      (cdr (assoc -1 (entget (cdr (assoc 330 ent_data)))))
		    )
		 )
		)
		((= (cdr (assoc 0 ent_data)) "LWPOLYLINE")
		 (setq ent_dat (car
				 (vl-remove-if-not
				   '(lambda (ent_dat) (= (cdr (assoc 0 ent_dat)) "HATCH"))
				   (mapcar 'entget (mapcar 'cdr (k_get_assoc ent_data 330)))
				 )
			       )
		 )
		 (if
		   (= (cdr (assoc 0 ent_dat))
		      "HATCH"
		   )
		    (entdel
		      (cdr (assoc -1 ent_dat))
		    )
		 )
		 (setq color	    (vla-get-color (k_->obj_name ent_name))
		       transparency (vla-get-EntityTransparency (k_->obj_name ent_name))
		       e_list	    (vl-remove-if-not
				      '(lambda (ent_name)
					 (= (cdr (assoc 0 (entget ent_name))) "LWPOLYLINE")
				       )
				      (mapcar 'cdr (k_get_assoc ent_dat 330))
				    )
		 )
		 (if (> (length e_list) 1)
		   (progn
		     (setq e_name (car
				    (l-2ndinhibition
				      e_list
				      (setq insel_list (mapcar 'k_->ent_name (k_pl-insel e_list)))
				    )
				  )
		     )
		     (command-s "_region" e_name "")
		     (setq e_name (entlast))
		     (foreach i_name insel_list
		       (command-s "_region" i_name "")
		       (command	"_subtract"
				e_name
				""
				(k_entlist->satz (entlast))
				""
		       )
		     )
		   )
		   (progn
		     (command-s "_region" (car e_list) "")
		     (setq e_name (entlast))
		   )
		 )
		 (setq satz (ssadd e_name satz))
		 (mapcar '(lambda (obj)
			    (if	obj
			      (progn
				(vla-put-color obj color)
				(vla-put-EntityTransparency obj transparency)
			      )
			    )
			  )
			 (k_satz->objlist satz)
		 )
		)
		((= (cdr (assoc 0 ent_data)) "HATCH")
		 (setq color	    (vla-get-color (k_->obj_name ent_name))
		       transparency (vla-get-EntityTransparency (k_->obj_name ent_name))
		       e_list	    (vl-remove-if-not
				      '(lambda (ent_name)
					 (= (cdr (assoc 0 (entget ent_name))) "LWPOLYLINE")
				       )
				      (mapcar 'cdr (k_get_assoc ent_data 330))
				    )
		 )
		 (if (> (length e_list) 1)
		   (progn
		     (setq e_name (car
				    (l-2ndinhibition
				      e_list
				      (setq insel_list (mapcar 'k_->ent_name (k_pl-insel e_list)))
				    )
				  )
		     )
		     (command-s "_region" e_name "")
		     (setq e_name (entlast))
		     (foreach i_name insel_list
		       (command-s "_region" i_name "")
		       (command	"_subtract"
				e_name
				""
				(k_entlist->satz (entlast))
				""
		       )
		     )
		   )
		   (progn
		     (command-s "_region" (car e_list) "")
		     (setq e_name (entlast))
		   )
		 )
		 (setq satz (ssadd e_name satz))
		 (entdel ent_name)
		 (mapcar '(lambda (obj)
			    (if	obj
			      (progn
				(vla-put-color obj color)
				(vla-put-EntityTransparency obj transparency)
			      )
			    )
			  )
			 (k_satz->objlist satz)
		 )
		)
	      )
	    )
	  )
	 )
	 ((member (cadr dummy) '(43))
	  (setq	modus "add"
		pen   nil
	  )
	 )
	 ((member (cadr dummy) '(45))
	  (setq	modus "sub"
		pen   nil
	  )
	 )
       )
      )
      ((= (car dummy) 3)
       (setq pen (k_not pen)
	     p	 (cadr dummy)
       )
       (print)
       (print
	 "d=Durchmesser, c=Color, t=Transparenz, e=Erweitern, +=Add, -=Sub, LMT=Stift heben/senken, RMT=Fertig"
       )
      )
      ((= (car dummy) 5)
       (setq p (cadr dummy))
      )
    )
    (if	(and pen (/= p_alt p))
      (progn
	(setq
	  circle_obj
	   (vla-AddLightWeightPolyline
	     (vla-get-block (k_ac-layout nil))
	     (k_liste->variant
	       (apply 'append
		      (k_3d->2d
			(mapcar	'(lambda (w) (polar p w (/ d 2.0)))
				(k_zahlenreihe_start_step 31 0 (/ pi 16.0))
			)
		      )
	       )
	       8197
	     )
	   )
	)
	(vla-put-closed circle_obj :vlax-true)
	(setq p_alt p
	      region-obj
	       (car (vlax-invoke
		      (vla-get-block (vla-get-activelayout (k_ac-doc)))
		      "addregion"
		      (list circle_obj)
		    )
	       )
	)
	(vla-put-color region-obj color)
	(vla-put-EntityTransparency region-obj transparency)
	(vla-delete circle_obj)
	(if (= modus "add")
	  (progn
	    (setq satz (ssadd (k_->ent_name region-obj) satz))
	    (command-s "_union" satz "")
	  )
	  (command-s "_subtract" satz "" "_l" "")
	)
	(mapcar	'(lambda (obj)
		   (if obj
		     (progn
		       (vla-put-color obj color)
		       (vla-put-EntityTransparency obj transparency)
		     )
		   )
		 )
		(k_satz->objlist satz)
	)
      )
      (if (not pen)
	(k_marker_show 256)
      )
    )
  )
  (k_marker_show 256)
  (setq ent_last (entlast))
  (k_save_var '("HpSeparate" "hpassoc" "HPISLANDDETECTION"))
  (setvar "HpSeparate" 1)
  (setvar "hpassoc" 0)
  (setvar "HPISLANDDETECTION" 0)
;;; alles schraffieren
  (command-s "-gschraff" "_p" "_s" "_s" satz "" "")
;;; Umgrenzung löschen weil zusammenhängend
  (mapcar 'vla-delete (vl-remove 'nil (k_satz->objlist satz)))
;;; Schraffuren ermitteln
  (setq satz (k_objlist->satz (k_lastobjects ent_last)))
  (setvar "hpassoc" 1)
  (setq b_list nil)
;;; neue separate Umgrenzungen
  (foreach obj (vl-remove nil (k_satz->objlist satz))
    (setq ent_last (entlast))
    (command-s "_HATCHGENERATEBOUNDARY" (k_->ent_name obj) "")
    (setq b_list (append b_list (k_lastobjects ent_last)))
    (vla-delete obj)
  )
;;; neu schraffieren, alles in den Hintergrund und alle Eigenschaften vergeben
  (setq ent_last (entlast))
  (command-s "-gschraff"
	     "_p"
	     "_s"
	     "_s"
	     (k_objlist->satz b_list)
	     ""
	     ""
  )
  (command-s "_.DRAWORDER"
	     (k_objlist->satz (append b_list (k_lastobjects ent_last)))
	     ""
	     "_b"
  )
  (foreach obj (append b_list (k_lastobjects ent_last))
    (vla-put-color (k_->obj_name obj) color)
    (vla-put-EntityTransparency
      (k_->obj_name obj)
      transparency
    )
  )
  (redraw)
  (k_restore_var
    '("HpSeparate" "hpassoc" "HPISLANDDETECTION" "cmdecho" "NOMUTT")
  )
  (vla-endundomark (k_ac-doc))
  (setq *error* olderr)
  (*pop-error-mode*)
)
;;; - ------------------------------------------------------------------------------ - ;
(princ
  (strcat
    "\nk_marker:  Markierungen erstellen"
    "\n===========  "
    "\n(C) Andreas Kraus 2024 (info@kraus-cad.de)"
    "\nBefehlszeilenaufruf : k_marker\n"
  )
)
;;; - ------------------------------------------------------------------------------ - ;
(princ)